C ECCHPO SOURCE PV090527 25/01/15 21:15:03 12125 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 PPARAM -INC CCOPTIO -INC CCGEOME -INC SMELEME -INC SMCHPOI -INC SMCOORD EXTERNAL LONG SEGMENT idcp(nbpts) 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) LL=MAX(1,LL) 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 ' ELSE IF (IFOPOI.EQ.16) THEN MOTERR(1:32)=' FREQUENTIEL ' ENDIF CALL ERREUR(-23) SEGINI,idcp DO i=1,NSOUPO MSOUPO=IPCHP(i) segact msoupo MELEME=IGEOC segact meleme MPOVAL=IPOVAL WRITE(IOIMP,25) i,MSOUPO DO j=1,idcp(/1) idcp(j)=0 ENDDO NPOIN=NUM(/2) C MAILLAGE %i1 : %i2 element(S) de type %m1:4 INTERR(1)=MELEME INTERR(2)=NPOIN INTERR(3)=0 MOTERR =NOMS(ITYPEL) CALL ERREUR(-19) DO j=1,NPOIN idcp(NUM(1,j))=j ENDDO if (mpoval.ne.0) then segact mpoval N =NOCOMP(/1) NC=NOCOMP(/2) INTERR(1)=MPOVAL INTERR(2)=VPOCHA(/1) INTERR(3)=VPOCHA(/2) CALL ERREUR(-372) IF (VPOCHA(/1) .NE. NPOIN)CALL ERREUR(5) 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 iDEB=iFIN+1 iFIN=(IE+1)*NCREF iFIN=MIN(NC,iFIN) ENDDO else C Cas du MPOVAL = 0 ?? INTERR(1)=MPOVAL INTERR(2)=0 INTERR(3)=0 CALL ERREUR(-372) endif ENDDO SEGSUP,idcp C DIFFERENTS FORMATS D'IMPRESSION 1 FORMAT(2X,4(15X,A8,3X)) 2 FORMAT(2X,2(15X,A8,7X,A8,3X)) 3 FORMAT(2X,2(15X,A8,7X,A8,7X,A8,3X)) 4 FORMAT(12X,8(5X,A8,2X)) 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,A8,1X,I4)) 22 FORMAT(2X,2(15X,A8,1X,I4,6X,A8,1X,I4)) 23 FORMAT(2X,2(15X,A8,1X,I4,6X,A8,1X,I4,6X,A8,1X,I4)) 24 FORMAT(12X,8(5X,A8,1X,I4)) 25 FORMAT(//10X,' SOUS-CHAMP NUMERO ',I6,' : MSOUPO',I10, & /10X,' -------------------------------------------') 187 FORMAT(//) RETURN END