Sources Esope | Cast3M

ecchpo
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