C VLOC2 SOURCE MB234859 25/09/08 21:16:17 12358 C SUBROUTINE VLOC2(IPMODL,IPMATE,IPCHE,IRET) C======================================================================= C C Fonction : CALCULE LES VECTEURS DE BASE DU REPERE D'ORTHOTROPIE C C Input : MODL : MODELE de calcul , type MMODEL C CHAML : CHAMELEM materiau (contenant les V1X V1Y ...) C C Output : CHAML : CHAMELEM aux POINTS DE GAUSS c contenant les vecteurs de base du repere local C de sous type VECTEURS LOCAUX c de composantes : c (UX UY UZ) (VX VY VZ) (WX WY WZ) en 3D c (UX UY) (VX VY) en 2D C C Creation : BP, 2017-01-17 (inspiré de VLOC1) C C===================================================================== C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) PARAMETER(UN=1.D0,XZER=0.D0) -INC PPARAM -INC CCOPTIO -INC CCHAMP -INC SMCHAML -INC SMMODEL -INC SMELEME -INC SMCOORD -INC SMINTE -INC TMPTVAL SEGMENT WRK1 REAL*8 XE(3,NBBB),XEL(3,NBBB) ENDSEGMENT SEGMENT WRK2 REAL*8 XE2(3,NBBB), BPSS2(3,3,NBBB) ENDSEGMENT SEGMENT NOTYPE CHARACTER*16 TYPE(NBTYPE) ENDSEGMENT DIMENSION BPSS(3,3),VV1(3),VV2(3),VV3(3) DIMENSION BPSS3(IDIM,IDIM) PARAMETER (NINF=3) INTEGER INFOS(NINF) CHARACTER*(NCONCH) CONM C===================================================================== NHRM = NIFOUR IRET = IDIM C C ACTIVATION DU MODELE C MMODEL= IPMODL SEGACT MMODEL NSOUS =KMODEL(/1) C C CREATION DU CHAMELEM C N1=NSOUS L1=15 N3=6 SEGINI MCHELM IPCHE=MCHELM TITCHE(1:15)='VECTEURS LOCAUX' IFOCHE=IFOUR NBTYPE = 1 SEGINI,NOTYPE NOTYPE.TYPE(1) = 'REAL*8' MOTYR8 = NOTYPE C____________________________________________________________________ C C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES C____________________________________________________________________ C ISORTH=0 DO 500 ISOUS=1,NSOUS C C ON RECUPERE L INFORMATION GENERALE C IMODEL=KMODEL(ISOUS) SEGACT IMODEL IPMAIL=IMAMOD IMACHE(ISOUS)=IPMAIL CONCHE(ISOUS)=CONMOD CONM = CONMOD C C TRAITEMENT DU MODELE C MELE=NEFMOD MELEME=IMAMOD NFOR=FORMOD(/2) NMAT=MATMOD(/2) c si le modele n'est pas orthotrope : on saute ! CALL PLACE(MATMOD,NMAT,KORTHO,'ORTHOTROPE') IF (KORTHO.EQ.0) GOTO 499 C____________________________________________________________________ C C INFORMATION SUR L'ELEMENT FINI C____________________________________________________________________ C MELE =INFELE(1) MFR =INFELE(13) c MINTE=segment MINTE aux points de Gauss MINTE=INFMOD(7) c MINTE1=segment MINTE aux noeuds (pour les coques epaisses) IF (MFR.EQ.5) MINTE1=INFMOD(3) c si formulation non prévue : on saute ! IF(MFR.NE.3.AND.MFR.NE.5.AND.MFR.NE.9 & .AND.MFR.NE.1.AND.MFR.NE.33) GOTO 499 c TODO : MFR = 7 35 31 45 (77) ... ISORTH=ISORTH+1 c write(*,*) ISOUS,' MFR=',MFR,' ok -> ',ISORTH,' zones ok',IFOUR C INFCHE(ISORTH,1)=0 INFCHE(ISORTH,2)=0 INFCHE(ISORTH,3)=NHRM INFCHE(ISORTH,4)=MINTE INFCHE(ISORTH,5)=0 * par defaut aux stresses INFCHE(ISORTH,6)=5 C C INITIALISATION DE MINTE C SEGACT MINTE NBPGAU=POIGAU(/1) C C ACTIVATION DU MELEME C SEGACT MELEME NBNN =NUM(/1) NBELEM=NUM(/2) C C RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER N1PTEL=NBPGAU N1EL=NBELEM N2PTEL = 0 N2EL = 0 C C CREATION DU MCHAML DE LA SOUS ZONE c C N2 = NOMBRE DE COMPOSANTES c cas massif et poreux IF(MFR.EQ.1.OR.MFR.EQ.33) THEN N2=IDIM*IDIM IF(IFOUR.eq.1) N2=9 c cas coques et zones cohesives ELSEIF(MFR.eq.3.or.MFR.eq.5.or.MFR.eq.9.or.MFR.eq.77) THEN c IF (IFOUR.EQ.-2) THEN c IF (IFOUR.EQ.0) THEN c N2=4 c ELSE N2=9 c ENDIF ELSE N2=0 call erreur(5) return ENDIF SEGINI MCHAML ICHAML(ISORTH)=MCHAML NSR=1 NCOSOR=N2 SEGINI MPTVAL IVAVLO=MPTVAL C C COMPOSANTES C C 3D + 2D DEF PLANES ET CONTRAINTES PLANES IF (IFOUR.EQ.2 .OR. IFOUR.EQ.-1 .OR. IFOUR.EQ.-2 & .OR. IFOUR.EQ.-3) THEN IF(N2.EQ.9) THEN NOMCHE(1)='V1X' NOMCHE(2)='V1Y' NOMCHE(3)='V1Z' NOMCHE(4)='V2X' NOMCHE(5)='V2Y' NOMCHE(6)='V2Z' NOMCHE(7)='V3X' NOMCHE(8)='V3Y' NOMCHE(9)='V3Z' ELSE NOMCHE(1)='V1X' NOMCHE(2)='V1Y' NOMCHE(3)='V2X' NOMCHE(4)='V2Y' ENDIF c AXI + 2D FOURIER ELSEIF(IFOUR.EQ.0 .OR. IFOUR.EQ.1) THEN IF(N2.EQ.9) THEN NOMCHE(1)='V1R' NOMCHE(2)='V1Z' NOMCHE(3)='V1T' NOMCHE(4)='V2R' NOMCHE(5)='V2Z' NOMCHE(6)='V2T' NOMCHE(7)='V3R' NOMCHE(8)='V3Z' NOMCHE(9)='V3T' ELSE NOMCHE(1)='V1R' NOMCHE(2)='V1Z' NOMCHE(3)='V2R' NOMCHE(4)='V2Z' ENDIF ELSE CALL ERREUR(717) ENDIF DO ICOMP=1,N2 TYPCHE(ICOMP)='REAL*8' SEGINI,MELVAL IELVAL(ICOMP)=MELVAL IVAL(ICOMP)=MELVAL ENDDO c write(*,*) ' MCHAML=',MCHAML,' N2=',N2 c write(*,*) ' NOMCHE=',(NOMCHE(iou),iou=1,N2) C____________________________________________________________________ c C RECHERCHE DES MELVAL DE MATERIAUX QUI NOUS INTERESSENT C____________________________________________________________________ NBROBL = 0 NBRFAC = 0 NOMID = 0 c COQUES + ZONES COHESIVES IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9 .OR. MFR.EQ.77) THEN NBROBL=2 SEGINI,NOMID LESOBL(1)='V1X' LESOBL(2)='V1Y' c MASSIFS ELSEIF(MFR.EQ.1.OR.MFR.EQ.33) THEN IF(IDIM.EQ.3.OR.IFOUR.EQ.1) THEN NBROBL=6 SEGINI,NOMID LESOBL(1)='V1X' LESOBL(2)='V1Y' LESOBL(3)='V1Z' LESOBL(4)='V2X' LESOBL(5)='V2Y' LESOBL(6)='V2Z' ELSE NBROBL=2 SEGINI,NOMID LESOBL(1)='V1X' LESOBL(2)='V1Y' ENDIF ENDIF MOCARA=NOMID c write(*,*) ' MATERIAU =',(LESOBL(iou),iou=1,NBROBL) * CREATION DU TABLEAU INFOS IRTD=1 CALL IDENT(IPMAIL,CONM,0,IPMATE,INFOS,IRTD) IF (IRTD.EQ.0) GOTO 499 c write(*,*) ' INFOS=',(INFOS(iou),iou=1,NINF) * RECHERCHE DES MELVAL CALL KOMCHA(IPMATE,IPMAIL,CONM,MOCARA,MOTYR8,1, & INFOS,NINF,IVAMAT) IF (IERR.NE.0) RETURN C MISE A ZERO INITIALE DO I=1,3 VV1(I)=0.D0 VV2(I)=0.D0 VV3(I)=0.D0 ENDDO C C____________________________________________________________________ C C AIGUILLAGE SELON FORMULATION et TYPE D ELEMENT C____________________________________________________________________ C c FORMULATION MASSIVE : ON CREE LE REPERE GLOBAL IF(MFR.EQ.1.OR.MFR.EQ.33) GOTO 1 c FORMULATION COQUE MINCE : OK IF(MFR.EQ.3.OR.MFR.EQ.9) GOTO 100 C TODO FORMULATION ZONES COHESIVES c IF(MFR.EQ.77) : BRANCHER LES ELEMENTS c FORMULATION COQUE EPAISSE : OK IF(MFR.EQ.5) GOTO 100 C TODO FORMULATION POUTRE ET TUYAU c IF(MFR.EQ.7.OR.MFR.EQ.13) GOTO 100 100 CONTINUE c 1 2 3 ... GOTO(99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, c ... 27,28 1 99,99,99,99,99,99,28,28,99,99,99,99,99,99,99,99,99,99,99,99, c 41 44 45 49 56 2 41,99,99,44,99,99,99,99,49,99,99,99,99,99,99,41,99,99,99,99, 3 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, c 93 4 99,99,99,99,99,99,99,99,99,99,99,99,28,99,99,99,99),MELE GOTO 99 c MELE = 27 -> COQ3 c MELE = 28 -> DKT c MELE = 41 -> COQ8 c MELE = 44 -> COQ2 c MELE = 45 -> POI1 ??? c MELE = 49 -> COQ4 c MELE = 56 -> COQ6 c MELE = 93 -> DST C_______________________________________________________________________ C C ELEMENTS MASSIFS C_______________________________________________________________________ C 1 CONTINUE NBBB=NBNN SEGINI WRK1 * RECUPERATION DES FONCTIONS DE FORME ET LEURS DERIVEES AU CENTRE DE * L'ELEMENT POUR LE CALCUL DES AXES LOCAUX IPMIN2 = 0 NLG=NUMGEO(MELE) CALL RESHPT(1,NBNN,NLG,MELE,0,IPMIN2,IRT1) MINTE2=IPMIN2 SEGACT MINTE2 C---- BOUCLE SUR LES ELEMENTS DO 3001 IB=1,NBELEM C C XE = COORDONNEES DES NOEUDS DE L ELEMENT IB CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) c BPSS = MATRICE DE PASSAGE = [ (u) (v) (w) ] NBSH=MINTE2.SHPTOT(/2) CALL RLOCAL(XE,MINTE2.SHPTOT,NBSH,NBNN,BPSS3) IF (NBSH.EQ.-1) THEN CALL ERREUR(525) GOTO 99 ENDIF C------ BOUCLE SUR LES POINTS DE GAUSS DO 4001 IGAU=1,NBPGAU c RECUP DES VALEURS MATERIAUX MPTVAL=IVAMAT MELVAL=IVAL(1) IGMN=MIN(IGAU,VELCHE(/1)) IBMN=MIN(IB,VELCHE(/2)) V1X=VELCHE(IGMN,IBMN) MELVAL=IVAL(2) IGMN=MIN(IGAU,VELCHE(/1)) IBMN=MIN(IB,VELCHE(/2)) V1Y=VELCHE(IGMN,IBMN) IF(IDIM.EQ.3.OR.IFOUR.EQ.1) THEN MELVAL=IVAL(3) IGMN=MIN(IGAU,VELCHE(/1)) IBMN=MIN(IB,VELCHE(/2)) V1Z=VELCHE(IGMN,IBMN) MELVAL=IVAL(4) IGMN=MIN(IGAU,VELCHE(/1)) IBMN=MIN(IB,VELCHE(/2)) V2X=VELCHE(IGMN,IBMN) MELVAL=IVAL(5) IGMN=MIN(IGAU,VELCHE(/1)) IBMN=MIN(IB,VELCHE(/2)) V2Y=VELCHE(IGMN,IBMN) MELVAL=IVAL(6) IGMN=MIN(IGAU,VELCHE(/1)) IBMN=MIN(IB,VELCHE(/2)) V2Z=VELCHE(IGMN,IBMN) ENDIF c CALCUL DE V1 V2 (et V3 en 3D) IF(IDIM.EQ.3) THEN VV1(1) = V1X*BPSS3(1,1)+V1Y*BPSS3(1,2)+V1Z*BPSS3(1,3) VV1(2) = V1X*BPSS3(2,1)+V1Y*BPSS3(2,2)+V1Z*BPSS3(2,3) VV1(3) = V1X*BPSS3(3,1)+V1Y*BPSS3(3,2)+V1Z*BPSS3(3,3) VV2(1) = V2X*BPSS3(1,1)+V2Y*BPSS3(1,2)+V2Z*BPSS3(1,3) VV2(2) = V2X*BPSS3(2,1)+V2Y*BPSS3(2,2)+V2Z*BPSS3(2,3) VV2(3) = V2X*BPSS3(3,1)+V2Y*BPSS3(3,2)+V2Z*BPSS3(3,3) c CALCUL DE V3 CALL CROSS2(VV1,VV2,VV3,IRET) ELSEIF(IFOUR.EQ.1) THEN VV1(1) = V1X*BPSS3(1,1)+V1Y*BPSS3(1,2) VV1(2) = V1X*BPSS3(2,1)+V1Y*BPSS3(2,2) VV2(1) = V2X*BPSS3(1,1)+V2Y*BPSS3(1,2) VV2(2) = V2X*BPSS3(2,1)+V2Y*BPSS3(2,2) VV1(3) = V1Z VV2(3) = V2Z CALL CROSS2(VV1,VV2,VV3,IRET) ELSE VV1(1) = V1X*BPSS3(1,1)+V1Y*BPSS3(1,2) VV1(2) = V1X*BPSS3(2,1)+V1Y*BPSS3(2,2) c en 2d calcul de v2 deduit de v1 VV2(1)=-1.D0*VV1(2) VV2(2)=VV1(1) ENDIF c ECRITURE DANS LES MELVAL MPTVAL=IVAVLO * boucle sur les composantes IF(N2.EQ.9) THEN DO I=1,3 MELVAL=IVAL(I) MELVAL.VELCHE(IGAU,IB)=VV1(I) MELVAL=IVAL(3+I) MELVAL.VELCHE(IGAU,IB)=VV2(I) MELVAL=IVAL(6+I) MELVAL.VELCHE(IGAU,IB)=VV3(I) ENDDO ELSE DO I=1,2 MELVAL=IVAL(I) MELVAL.VELCHE(IGAU,IB)=VV1(I) MELVAL=IVAL(2+I) MELVAL.VELCHE(IGAU,IB)=VV2(I) ENDDO ENDIF 4001 CONTINUE C------ FIN DE BOUCLE SUR LES POINTS DE GAUSS 3001 CONTINUE SEGDES MINTE2 SEGSUP,WRK1 GOTO 99 C_______________________________________________________________________ C C ELEMENTS COQ3, DKT et DST C_______________________________________________________________________ C 28 CONTINUE NBBB=NBNN SEGINI WRK1 C---- BOUCLE SUR LES ELEMENTS DO 3028 IB=1,NBELEM C C XE = COORDONNEES DES NOEUDS DE L ELEMENT IB CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) c BPSS = MATRICE DE PASSAGE = [ (u) (v) (w) ] CALL VPAST(XE,BPSS) C------ BOUCLE SUR LES POINTS DE GAUSS DO 4028 IGAU=1,NBPGAU c RECUP DES VALEURS MATERIAUX MPTVAL=IVAMAT MELVAL=IVAL(1) IGMN=MIN(IGAU,VELCHE(/1)) IBMN=MIN(IB,VELCHE(/2)) V1X=VELCHE(IGMN,IBMN) MELVAL=IVAL(2) V1Y=VELCHE(IGMN,IBMN) c CALCUL DE V1 ET V3 VV1(1) = V1X*BPSS(1,1)+V1Y*BPSS(2,1) VV1(2) = V1X*BPSS(1,2)+V1Y*BPSS(2,2) VV1(3) = V1X*BPSS(1,3)+V1Y*BPSS(2,3) VV3(1) = BPSS(3,1) VV3(2) = BPSS(3,2) VV3(3) = BPSS(3,3) c CALCUL DE V2 CALL CROSS2(VV3,VV1,VV2,IRET) c IF(IRET) c ECRITURE DANS LES MELVAL MPTVAL=IVAVLO * boucle sur la dimension DO I=1,3 MELVAL=IVAL(I) MELVAL.VELCHE(IGAU,IB)=VV1(I) MELVAL=IVAL(3+I) MELVAL.VELCHE(IGAU,IB)=VV2(I) MELVAL=IVAL(6+I) MELVAL.VELCHE(IGAU,IB)=VV3(I) ENDDO 4028 CONTINUE C------ FIN DE BOUCLE SUR LES POINTS DE GAUSS 3028 CONTINUE C---- FIN DE BOUCLE SUR LES ELEMENTS SEGSUP,WRK1 GOTO 99 C_______________________________________________________________________ C C ELEMENT COQ8 et COQ6 C_______________________________________________________________________ C 41 CONTINUE NBBB=NBNN SEGINI WRK2 SEGACT MINTE1 C---- BOUCLE SUR LES ELEMENTS DO 3041 IB=1,NBELEM C C XE = COORDONNEES DES NOEUDS DE L ELEMENT IB CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE2) C DETERMINATION DES AXES LOCAUX AUX NOEUDS CALL CQ8LOC(XE2,NBNN,MINTE1.SHPTOT,BPSS2,IRR) C GESTION D'ERREUR:IRR=0 CORRESPOND A UN VECTEUR NUL (CF. CROSS2) C IRR=-1 CORRESPOND A UN JACOBIEN NUL(CF. SHLJAC) IF(IRR.EQ.0) THEN CALL ERREUR(241) GOTO 3041 ELSE IF(IRR.EQ.-1)THEN CALL ERREUR(240) GOTO 3041 ENDIF C------ BOUCLE SUR LES POINTS DE GAUSS DO 4041 IGAU=1,NBPGAU c CALCUL DES AXES LOCAUX AUX POINTS DE GAUSS c BPSS(J1,J2) = vecteurs locaux au point de Gauss c avec J1 = indice du vecteur local (u,v,w) c J2 = indice du repere global (X,Y,Z) DO J2=1,3 DO J1=1,3 r_z = 0.D0 DO I=1,NBNN r_z = r_z + SHPTOT(1,I,IGAU)*BPSS2(J2,J1,I) ENDDO BPSS(J1,J2) = r_z ENDDO ENDDO c RECUP DES VALEURS MATERIAUX MPTVAL=IVAMAT MELVAL=IVAL(1) IGMN=MIN(IGAU,VELCHE(/1)) IBMN=MIN(IB,VELCHE(/2)) V1X=VELCHE(IGMN,IBMN) MELVAL=IVAL(2) V1Y=VELCHE(IGMN,IBMN) c CALCUL DE V1 ET V3 DO I=1,3 VV1(I) = V1X*BPSS(1,I)+V1Y*BPSS(2,I) VV3(I) = BPSS(3,I) ENDDO c CALCUL DE V2 CALL CROSS2(VV3,VV1,VV2,IRET) c IF(IRET) c ECRITURE DANS LES MELVAL MPTVAL=IVAVLO * boucle sur la dimension DO I=1,3 MELVAL=IVAL(I) MELVAL.VELCHE(IGAU,IB)=VV1(I) MELVAL=IVAL(3+I) MELVAL.VELCHE(IGAU,IB)=VV2(I) MELVAL=IVAL(6+I) MELVAL.VELCHE(IGAU,IB)=VV3(I) ENDDO 4041 CONTINUE C------ FIN DE BOUCLE SUR LES POINTS DE GAUSS 3041 CONTINUE C---- FIN DE BOUCLE SUR LES ELEMENTS SEGSUP,WRK2 GOTO 99 C_______________________________________________________________________ C C SECTEUR DE CALCUL POUR LE COQ2 C_______________________________________________________________________ C 44 CONTINUE NBBB=NBNN SEGINI WRK1 C---- BOUCLE SUR LES ELEMENTS DO 3044 IB=1,NBELEM C C XE = COORDONNEES DES NOEUDS DE L ELEMENT IB CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) c BPSS = MATRICE DE PASSAGE CALL VPAST2(XE,BPSS) C------ BOUCLE SUR LES POINTS DE GAUSS DO 4044 IGAU=1,NBPGAU c RECUP DES VALEURS MATERIAUX MPTVAL=IVAMAT MELVAL=IVAL(1) IGMN=MIN(IGAU,VELCHE(/1)) IBMN=MIN(IB,VELCHE(/2)) V1X=VELCHE(IGMN,IBMN) MELVAL=IVAL(2) V1Y=VELCHE(IGMN,IBMN) c IF(IFOUR.EQ.0 .OR. IFOUR.EQ.1) THEN c c CALCUL DE V1 ET V3 c DO I=1,3 c VV1(I) = V1X*BPSS(I,1)+V1Y*BPSS(I,2) c VV2(I) = BPSS(I,3) c ENDDO c c CALCUL DE V2 c CALL CROSS2(VV2,VV1,VV3,IRET) c ELSE c CALCUL DE V1 ET V3 DO I=1,3 VV1(I) = V1X*BPSS(1,I)+V1Y*BPSS(2,I) VV3(I) = BPSS(3,I) ENDDO c CALCUL DE V2 CALL CROSS2(VV3,VV1,VV2,IRET) c ENDIF c IF(IRET) c ECRITURE DANS LES MELVAL MPTVAL=IVAVLO * boucle sur la dimension DO I=1,3 MELVAL=IVAL(I) MELVAL.VELCHE(IGAU,IB)=VV1(I) MELVAL=IVAL(3+I) MELVAL.VELCHE(IGAU,IB)=VV2(I) MELVAL=IVAL(6+I) MELVAL.VELCHE(IGAU,IB)=VV3(I) ENDDO 4044 CONTINUE C------ FIN DE BOUCLE SUR LES POINTS DE GAUSS 3044 CONTINUE C---- FIN DE BOUCLE SUR LES ELEMENTS SEGSUP,WRK1 GOTO 99 C_______________________________________________________________________ C C SECTEUR DE CALCUL POUR LE COQ4 C_______________________________________________________________________ C 49 CONTINUE NBBB=NBNN SEGINI WRK1 C---- BOUCLE SUR LES ELEMENTS DO 3049 IB=1,NBELEM C C XE = COORDONNEES DES NOEUDS DE L ELEMENT IB CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) c BPSS = MATRICE DE PASSAGE = [ (u) (v) (w) ]T CALL CQ4LOC(XE,XEL,BPSS,IRRT,1) do i=1,3 c write(*,*) 'BPSS(',i,',:)=',(BPSS(i,jou),jou=1,3) enddo C------ BOUCLE SUR LES POINTS DE GAUSS DO 4049 IGAU=1,NBPGAU c RECUP DES VALEURS MATERIAUX MPTVAL=IVAMAT MELVAL=IVAL(1) IGMN=MIN(IGAU,VELCHE(/1)) IBMN=MIN(IB,VELCHE(/2)) V1X=VELCHE(IGMN,IBMN) MELVAL=IVAL(2) V1Y=VELCHE(IGMN,IBMN) c write(*,*) 'V1X,V1Y=',V1X,V1Y c CALCUL DE V1 ET V3 DO I=1,3 VV1(I) = V1X*BPSS(1,I)+V1Y*BPSS(2,I) VV3(I) = BPSS(3,I) ENDDO c CALCUL DE V2 CALL CROSS2(VV3,VV1,VV2,IRET) c IF(IRET) c ECRITURE DANS LES MELVAL MPTVAL=IVAVLO * boucle sur la dimension DO I=1,3 MELVAL=IVAL(I) MELVAL.VELCHE(IGAU,IB)=VV1(I) MELVAL=IVAL(3+I) MELVAL.VELCHE(IGAU,IB)=VV2(I) MELVAL=IVAL(6+I) MELVAL.VELCHE(IGAU,IB)=VV3(I) ENDDO 4049 CONTINUE C------ FIN DE BOUCLE SUR LES POINTS DE GAUSS 3049 CONTINUE C---- FIN DE BOUCLE SUR LES ELEMENTS SEGSUP,WRK1 GOTO 99 C--------------------------------------------------------------------- C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS C--------------------------------------------------------------------- 99 CONTINUE MPTVAL=IVAVLO DO I2=1,N2 MELVAL=IVAL(I2) IF (MELVAL.NE.0) SEGDES MELVAL ENDDO SEGSUP MPTVAL C SEGDES MINTE SEGDES MELEME SEGDES MCHAML C IF (MFR.EQ.5) THEN SEGDES MINTE1 ENDIF 499 SEGDES IMODEL 500 CONTINUE C____________________________________________________________________ C C FIN DE LA BOUCLE SUR LES DIFFERENTES ZONES C____________________________________________________________________ N1=ISORTH L1=15 N3=6 SEGADJ,MCHELM SEGDES MCHELM SEGDES MMODEL NOTYPE = MOTYR8 SEGSUP,NOTYPE RETURN C END