C PROJC2 SOURCE GOUNAND 16/12/01 21:15:14 9218 SUBROUTINE PROJC2(IMBOIT,IOEIL,CGRAV,XBMIN,XBMAX,YBMIN $ ,YBMAX,ZBMIN,ZBMAX) C*********************************************************************** C NOM : PROJC2 C DESCRIPTION : Calcul des coordonnées de la fenêtre de tracé C centrée sur le maillage IMBOIT C C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! C C ATTENTION : il faut que ce calcul, repris de prtrac.eso C et projec.eso a la creation reste consistant C avec ce qui est fait par ailleurs C dans prtrac.eso et projec.eso C C C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! C C C C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C VERSION : v1, 29/11/2016, version initiale C HISTORIQUE : v1, 29/11/2016, création C HISTORIQUE : C HISTORIQUE : C*********************************************************************** IMPLICIT INTEGER(I-N) REAL*8 XO,XG,XP,XN,SN,XV,SV,UI,UJ DIMENSION XO(3),XP(3),XN(3),XG(3),XV(3),UI(3),UJ(3),CGRAV(*) -INC PPARAM -INC CCOPTIO -INC CCREEL -INC SMCOORD -INC SMELEME POINTEUR IMBOIT.MELEME SEGMENT XPBOIT(3,NNODE) SEGACT MCOORD * segact imboit nnode=imboit.num(/2) * segini xpboit IF (IDIM.NE.2) GOTO 5500 DO 5501 inode=1,nnode nuno=imboit.num(1,inode) XPBOIT(1,inode)=XCOOR(nuno*3-2) XPBOIT(2,inode)=XCOOR(nuno*3-1) 5501 CONTINUE GOTO 5502 5500 CONTINUE IREF=(IOEIL-1)*4 XO(1)=XCOOR(IREF+1) XO(2)=XCOOR(IREF+2) XO(3)=XCOOR(IREF+3) DO J=1,3 XG(J)=CGRAV(J) XN(J)=XO(J)-XG(J) ENDDO C NORMALE AU PLAN SN=SQRT(XN(1)**2+XN(2)**2+XN(3)**2) IF (SN.EQ.0.) CALL ERREUR(21) IF (IERR.NE.0) RETURN DO 5 J=1,3 XN(J)=XN(J)/SN 5 CONTINUE C REPERE LOCAL SUR LE PLAN UJ(1)=0.D0 UJ(2)=0.D0 UJ(3)=1.D0 21 CONTINUE SV=UJ(1)*XN(1)+UJ(2)*XN(2)+UJ(3)*XN(3) DO 20 J=1,3 UJ(J)=UJ(J)-SV*XN(J) 20 CONTINUE SV=UJ(1)**2+UJ(2)**2+UJ(3)**2 IF (ABS(SV).LT.0.01) THEN UJ(1)=0.D0 UJ(2)=1.D0 UJ(3)=1.D0 GOTO 21 ENDIF SV=SQRT(SV) UJ(1)=UJ(1)/SV UJ(2)=UJ(2)/SV UJ(3)=UJ(3)/SV UI(1)=UJ(2)*XN(3)-UJ(3)*XN(2) UI(2)=UJ(3)*XN(1)-UJ(1)*XN(3) UI(3)=UJ(1)*XN(2)-UJ(2)*XN(1) C PROJECTION CONIQUE SUR LE PLAN DO 12 inode=1,nnode i=imboit.num(1,inode) DO 13 J=1,3 XP(J)=XCOOR(I*4-4+J) XV(J)=XP(J)-XO(J) 13 CONTINUE * XPBOIT(3,ICPR(I))=SQRT(XV(1)**2+XV(2)**2+XV(3)**2) SV=XV(1)*XN(1)+XV(2)*XN(2)+XV(3)*XN(3) SN=(XP(1)-XG(1))*XN(1)+(XP(2)-XG(2))*XN(2)+(XP(3)-XG(3))*XN(3) XPBOIT(3,inode)=-SN DO 14 J=1,3 XP(J)=XP(J)-(SN/SV)*XV(J)-XG(J) 14 CONTINUE XPBOIT(1,inode)=XP(1)*UI(1)+XP(2)*UI(2)+XP(3)*UI(3) XPBOIT(2,inode)=XP(1)*UJ(1)+XP(2)*UJ(2)+XP(3)*UJ(3) 12 CONTINUE 5502 CONTINUE * calcul des mins et max XBMIN=1E30 XBMAX=-XBMIN YBMIN=XBMIN YBMAX=XBMAX ZBMIN=XBMIN ZBMAX=XBMAX DO inode=1,nnode XBMIN=MIN(XBMIN,XPBOIT(1,inode)) XBMAX=MAX(XBMAX,XPBOIT(1,inode)) YBMIN=MIN(YBMIN,XPBOIT(2,inode)) YBMAX=MAX(YBMAX,XPBOIT(2,inode)) ZBMIN=MIN(ZBMIN,XPBOIT(3,inode)) ZBMAX=MAX(ZBMAX,XPBOIT(3,inode)) ENDDO *goo WRITE(IOIMP,*) 'PROJC2 : XBMIN,YBMIN,XBMAX,YBMAX,ZBMIN,ZBMAX=', *goo $ XBMIN,YBMIN,XBMAX,YBMAX,ZBMIN,ZBMAX C XBDEC=XBMAX-XBMIN YBDEC=YBMAX-YBMIN ZBDEC=ZBMAX-ZBMIN *goo WRITE(IOIMP,*) 'PROJC2 : XBDEC,YBDEC,ZBDEC=',XBDEC,YBDEC,ZBDEC * Modif des marges * Nouveau : DDEC=MAX(XBDEC,YBDEC,ZBDEC)*0.1 * MODIF JCARDO 28/02/2012 : DDEC vaut maintenant XSZPRE au minimum * (evite des erreurs de cancellation) DDEC=MAX(DDEC,xszpre) * DDEC=MAX(DDEC,xspeti) XBMAX=XBMAX+DDEC XBMIN=XBMIN-DDEC YBMIN=YBMIN-DDEC YBMAX=YBMAX+DDEC ZBMIN=ZBMIN-DDEC ZBMAX=ZBMAX+DDEC SEGSUP XPBOIT RETURN END