C ECCHPO SOURCE PV 13/04/11 21:15:42 7755 C======================================================================= C= E C C H P O = C= ----------- = C= = C= Fonction : = C= ---------- = C= Impression d'un champ par points = C= = C= Parametres : (E)=Entree (S)=Sortie = C= ------------ = C= IRET (E) Pointeur sur le segment MCHPOI du champ a imprimer = C= jentet (E) =1 si on ne veut que l'entete de l'impression = C======================================================================= SUBROUTINE ECCHPO(IRET,jentet) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC CCOPTIO -INC SMELEME -INC SMCHPOI -INC SMCOORD EXTERNAL LONG SEGMENT idcp(XCOOR(/1)/(IDIM+1)) CHARACTER*140 ITEX DATA NCREF / 8 / MCHPOI=IRET SEGACT,MCHPOI NSOUPO=IPCHP(/1) NAT=JATTRI(/1) WRITE(IOIMP,9) INTERR(1)=MCHPOI INTERR(2)=NSOUPO LL=MIN(LONG(MOCHDE),40) MOTERR=MOCHDE(1:LL) CALL ERREUR(-21) MOTERR=MTYPOI CALL ERREUR(-22) C LIST DES ATTRIBUTS DE NATURE IF (NAT.GE.1) THEN MOTERR(1:11)='INDETERMINE' IF (JATTRI(1).EQ.1) MOTERR(1:11)='DIFFUS ' IF (JATTRI(1).EQ.2) MOTERR(1:11)='DISCRET ' CALL ERREUR(-289) ENDIF C Option de calcul (on suppose que IFOPOI correspond a IFOUR) IF (IFOPOI.LE.-1) THEN MOTERR(1:32)=' PLAN ' ELSE IF (IFOPOI.EQ.0) THEN MOTERR(1:32)=' AXISYMETRIQUE ' ELSE IF (IFOPOI.EQ.1) THEN MOTERR(1:32)=' SERIE DE FOURIER ' ELSE IF (IFOPOI.EQ.2) THEN MOTERR(1:32)=' TRIDIMENSIONNEL ' ELSE IF (IFOPOI.GE.3.AND.IFOPOI.LE.11) THEN MOTERR(1:32)=' UNID PLAN ' ELSE IF (IFOPOI.GE.12.AND.IFOPOI.LE.14) THEN MOTERR(1:32)=' UNID AXISYMETRIQUE ' ELSE IF (IFOPOI.EQ.15) THEN MOTERR(1:32)=' UNID SPHERIQUE ' ENDIF CALL ERREUR(-23) SEGINI,idcp DO i=1,NSOUPO DO j=1,idcp(/1) idcp(j)=0 ENDDO MSOUPO=IPCHP(i) SEGACT,MSOUPO MELEME=IGEOC SEGACT,MELEME NPOIN=NUM(/2) DO j=1,NPOIN idcp(NUM(1,j))=j ENDDO MPOVAL=IPOVAL if (mpoval.ne.0) then SEGACT,MPOVAL NC=NOCOMP(/2) IECRI=(NC-1)/NCREF+1 iDEB=1 iFIN=MIN(NC,NCREF) DO IE=1,IECRI IFI=iFIN-iDEB+1 NPREF=1 IF (IFI.EQ.1) NPREF=4 IF (IFI.EQ.2.OR.IFI.EQ.3) NPREF=2 NPMIN=MIN(NPOIN,NPREF) ILIG=(NPOIN-1)/NPREF+1 IDEBP=1 IFINP=MIN(NPOIN,NPREF) IF (IFOPOI.EQ.1) THEN CALL ERREUR(-24) IF (IFI.EQ.1) THEN WRITE(IOIMP,21) ((NOCOMP(j),NOHARM(j),j=iDEB,iFIN), . k=1,NPMIN) ELSE IF (IFI.EQ.2) THEN WRITE(IOIMP,22) ((NOCOMP(j),NOHARM(j),j=iDEB,iFIN), . k=1,NPMIN) ELSE IF (IFI.EQ.3) THEN WRITE(IOIMP,23) ((NOCOMP(j),NOHARM(j),j=iDEB,iFIN), . k=1,NPMIN) ELSE WRITE(IOIMP,24) ((NOCOMP(j),NOHARM(j),j=iDEB,iFIN), . k=1,NPMIN) ENDIF ELSE CALL ERREUR(-25) IF (IFI.EQ.1) THEN WRITE(IOIMP,1) ((NOCOMP(j),j=iDEB,iFIN),k=1,NPMIN) ELSE IF (IFI.EQ.2) THEN WRITE(IOIMP,2) ((NOCOMP(j),j=iDEB,iFIN),k=1,NPMIN) ELSE IF (IFI.EQ.3) THEN WRITE(IOIMP,3) ((NOCOMP(j),j=iDEB,iFIN),k=1,NPMIN) ELSE WRITE(IOIMP,4) ((NOCOMP(j),j=iDEB,iFIN),k=1,NPMIN) ENDIF ENDIF ip=0 IF (jentet.EQ.1) ilig=MIN(ilig,5) DO IL=1,ILIG IF (IERR.NE.0) RETURN ITEX=' ' JH=0 DO JHDD=IDEBP,IFINP JH=JH+1 183 ip=ip+1 IF (idcp(ip).EQ.0.AND.ip.LT.idcp(/1)) GOTO 183 jhd=idcp(ip) iWri=NUM(1,JHD) IF (iWri.NE.ip) CALL ERREUR(5) IF (IFI.EQ.1) THEN IF (JH.EQ.1) THEN WRITE(ITEX(1:26),5) iWri,(VPOCHA(JHD,j),j=iDEB,iFIN) ELSE IF(JH.EQ.2) THEN WRITE(ITEX(27:53),5) iWri,(VPOCHA(JHD,j),j=iDEB,iFIN) ELSE IF (JH.EQ.3) THEN WRITE(ITEX(54:79),5) iWri,(VPOCHA(JHD,j),j=iDEB,iFIN) ELSE IF (JH.EQ.4) THEN WRITE(ITEX(80:105),5) iWri,(VPOCHA(JHD,j),j=iDEB,iFIN) ENDIF ELSE IF (IFI.EQ.2) THEN IF (JH.EQ.1) THEN WRITE(ITEX(1:41),6) iWri,(VPOCHA(JHD,j),j=iDEB,iFIN) ELSE IF (JH.EQ.2) THEN WRITE(ITEX(42:82),6) iWri,(VPOCHA(JHD,j),j=iDEB,iFIN) ENDIF ELSE IF (IFI.EQ.3) THEN IF (JH.EQ.1) THEN WRITE(ITEX(1:56),7) iWri,(VPOCHA(JHD,j),j=iDEB,iFIN) ELSE IF (JH.EQ.2) THEN WRITE(ITEX(57:112),7) iWri,(VPOCHA(JHD,j),j=iDEB,iFIN) ENDIF ELSE WRITE(ITEX(1:133),8) iWri,(VPOCHA(JHD,j),j=iDEB,iFIN) ENDIF ENDDO IDEBP=IFINP+1 IFINP=(IL+1)*NPREF IFINP=MIN(NPOIN,IFINP) WRITE(IOIMP,10) ITEX ENDDO WRITE(IOIMP,9) iDEB=iFIN+1 iFIN=(IE+1)*NCREF iFIN=MIN(NC,iFIN) ENDDO SEGDES,MELEME,MPOVAL,MSOUPO endif ENDDO WRITE(IOIMP,187) SEGSUP,idcp SEGDES,MCHPOI C DIFFERENTS FORMATS D'IMPRESSION 1 FORMAT(2X,4(15X,A4,5X)) 2 FORMAT(2X,2(15X,A4,11X,A4,5X)) 3 FORMAT(2X,2(15X,A4,11X,A4,11X,A4,5X)) 4 FORMAT(12X,8(5X,A4,6X)) 5 FORMAT(2X,I8,4X,1PE12.5) 6 FORMAT(2X,I8,4X,1PE12.5,3X,1PE12.5) 7 FORMAT(2X,I8,4X,1PE12.5,3X,1PE12.5,3X,1PE12.5) 8 FORMAT(2X,I8,3X,8(1X,1PE12.5,2X)) 9 FORMAT(/) 10 FORMAT(A132) 21 FORMAT(2X,4(15X,A4,1X,I4)) 22 FORMAT(2X,2(15X,A4,1X,I4,6X,A4,1X,I4)) 23 FORMAT(2X,2(15X,A4,1X,I4,6X,A4,1X,I4,6X,A4,1X,I4)) 24 FORMAT(12X,8(5X,A4,1X,I4)) 187 FORMAT(//) RETURN END