1 : C ECCHPO SOURCE PV 13/04/11 21:15:42 7755 2 : 3 : C======================================================================= 4 : C= E C C H P O = 5 : C= ----------- = 6 : C= = 7 : C= Fonction : = 8 : C= ---------- = 9 : C= Impression d'un champ par points = 10 : C= = 11 : C= Parametres : (E)=Entree (S)=Sortie = 12 : C= ------------ = 13 : C= IRET (E) Pointeur sur le segment MCHPOI du champ a imprimer = 14 : C= jentet (E) =1 si on ne veut que l'entete de l'impression = 15 : C======================================================================= 16 : 17 : SUBROUTINE ECCHPO(IRET,jentet) 18 : 19 : IMPLICIT INTEGER(I-N) 20 : IMPLICIT REAL*8 (A-H,O-Z) 21 : 22 : -INC CCOPTIO 23 : -INC SMELEME 24 : -INC SMCHPOI 25 : -INC SMCOORD 26 : 27 : EXTERNAL LONG 28 : 29 : SEGMENT idcp(XCOOR(/1)/(IDIM+1)) 30 : 31 : CHARACTER*140 ITEX 32 : 33 : DATA NCREF / 8 / 34 : 35 : MCHPOI=IRET 36 : SEGACT,MCHPOI 37 : NSOUPO=IPCHP(/1) 38 : NAT=JATTRI(/1) 39 : 40 : WRITE(IOIMP,9) 41 : INTERR(1)=MCHPOI 42 : INTERR(2)=NSOUPO 43 : LL=MIN(LONG(MOCHDE),40) 44 : MOTERR=MOCHDE(1:LL) 44 : CALL ERREUR(-21) 45 : MOTERR=MTYPOI 45 : CALL ERREUR(-22) 46 : 47 : C LIST DES ATTRIBUTS DE NATURE 48 : IF (NAT.GE.1) THEN 49 : MOTERR(1:11)='INDETERMINE' 50 : IF (JATTRI(1).EQ.1) MOTERR(1:11)='DIFFUS ' 51 : IF (JATTRI(1).EQ.2) MOTERR(1:11)='DISCRET ' 51 : CALL ERREUR(-289) 52 : ENDIF 53 : 54 : C Option de calcul (on suppose que IFOPOI correspond a IFOUR) 55 : IF (IFOPOI.LE.-1) THEN 56 : MOTERR(1:32)=' PLAN ' 57 : ELSE IF (IFOPOI.EQ.0) THEN 58 : MOTERR(1:32)=' AXISYMETRIQUE ' 59 : ELSE IF (IFOPOI.EQ.1) THEN 60 : MOTERR(1:32)=' SERIE DE FOURIER ' 61 : ELSE IF (IFOPOI.EQ.2) THEN 62 : MOTERR(1:32)=' TRIDIMENSIONNEL ' 63 : ELSE IF (IFOPOI.GE.3.AND.IFOPOI.LE.11) THEN 64 : MOTERR(1:32)=' UNID PLAN ' 65 : ELSE IF (IFOPOI.GE.12.AND.IFOPOI.LE.14) THEN 66 : MOTERR(1:32)=' UNID AXISYMETRIQUE ' 67 : ELSE IF (IFOPOI.EQ.15) THEN 68 : MOTERR(1:32)=' UNID SPHERIQUE ' 69 : ENDIF 69 : CALL ERREUR(-23) 70 : 71 : SEGINI,idcp 72 : DO i=1,NSOUPO 73 : DO j=1,idcp(/1) 74 : idcp(j)=0 75 : ENDDO 76 : MSOUPO=IPCHP(i) 77 : SEGACT,MSOUPO 78 : MELEME=IGEOC 79 : SEGACT,MELEME 80 : NPOIN=NUM(/2) 81 : DO j=1,NPOIN 82 : idcp(NUM(1,j))=j 83 : ENDDO 84 : MPOVAL=IPOVAL 85 : if (mpoval.ne.0) then 86 : SEGACT,MPOVAL 87 : NC=NOCOMP(/2) 88 : IECRI=(NC-1)/NCREF+1 89 : iDEB=1 90 : iFIN=MIN(NC,NCREF) 91 : DO IE=1,IECRI 92 : IFI=iFIN-iDEB+1 93 : NPREF=1 94 : IF (IFI.EQ.1) NPREF=4 95 : IF (IFI.EQ.2.OR.IFI.EQ.3) NPREF=2 96 : NPMIN=MIN(NPOIN,NPREF) 97 : ILIG=(NPOIN-1)/NPREF+1 98 : IDEBP=1 99 : IFINP=MIN(NPOIN,NPREF) 100 : IF (IFOPOI.EQ.1) THEN 100 : CALL ERREUR(-24) 101 : IF (IFI.EQ.1) THEN 102 : WRITE(IOIMP,21) ((NOCOMP(j),NOHARM(j),j=iDEB,iFIN), 103 : . k=1,NPMIN) 104 : ELSE IF (IFI.EQ.2) THEN 105 : WRITE(IOIMP,22) ((NOCOMP(j),NOHARM(j),j=iDEB,iFIN), 106 : . k=1,NPMIN) 107 : ELSE IF (IFI.EQ.3) THEN 108 : WRITE(IOIMP,23) ((NOCOMP(j),NOHARM(j),j=iDEB,iFIN), 109 : . k=1,NPMIN) 110 : ELSE 111 : WRITE(IOIMP,24) ((NOCOMP(j),NOHARM(j),j=iDEB,iFIN), 112 : . k=1,NPMIN) 113 : ENDIF 114 : ELSE 114 : CALL ERREUR(-25) 115 : IF (IFI.EQ.1) THEN 116 : WRITE(IOIMP,1) ((NOCOMP(j),j=iDEB,iFIN),k=1,NPMIN) 117 : ELSE IF (IFI.EQ.2) THEN 118 : WRITE(IOIMP,2) ((NOCOMP(j),j=iDEB,iFIN),k=1,NPMIN) 119 : ELSE IF (IFI.EQ.3) THEN 120 : WRITE(IOIMP,3) ((NOCOMP(j),j=iDEB,iFIN),k=1,NPMIN) 121 : ELSE 122 : WRITE(IOIMP,4) ((NOCOMP(j),j=iDEB,iFIN),k=1,NPMIN) 123 : ENDIF 124 : ENDIF 125 : ip=0 126 : IF (jentet.EQ.1) ilig=MIN(ilig,5) 127 : DO IL=1,ILIG 128 : IF (IERR.NE.0) RETURN 129 : ITEX=' ' 130 : JH=0 131 : DO JHDD=IDEBP,IFINP 132 : JH=JH+1 133 : 183 ip=ip+1 134 : IF (idcp(ip).EQ.0.AND.ip.LT.idcp(/1)) GOTO 183 135 : jhd=idcp(ip) 136 : iWri=NUM(1,JHD) 136 : IF (iWri.NE.ip) CALL ERREUR(5) 137 : IF (IFI.EQ.1) THEN 138 : IF (JH.EQ.1) THEN 139 : WRITE(ITEX(1:26),5) iWri,(VPOCHA(JHD,j),j=iDEB,iFIN) 140 : ELSE IF(JH.EQ.2) THEN 141 : WRITE(ITEX(27:53),5) iWri,(VPOCHA(JHD,j),j=iDEB,iFIN) 142 : ELSE IF (JH.EQ.3) THEN 143 : WRITE(ITEX(54:79),5) iWri,(VPOCHA(JHD,j),j=iDEB,iFIN) 144 : ELSE IF (JH.EQ.4) THEN 145 : WRITE(ITEX(80:105),5) iWri,(VPOCHA(JHD,j),j=iDEB,iFIN) 146 : ENDIF 147 : ELSE IF (IFI.EQ.2) THEN 148 : IF (JH.EQ.1) THEN 149 : WRITE(ITEX(1:41),6) iWri,(VPOCHA(JHD,j),j=iDEB,iFIN) 150 : ELSE IF (JH.EQ.2) THEN 151 : WRITE(ITEX(42:82),6) iWri,(VPOCHA(JHD,j),j=iDEB,iFIN) 152 : ENDIF 153 : ELSE IF (IFI.EQ.3) THEN 154 : IF (JH.EQ.1) THEN 155 : WRITE(ITEX(1:56),7) iWri,(VPOCHA(JHD,j),j=iDEB,iFIN) 156 : ELSE IF (JH.EQ.2) THEN 157 : WRITE(ITEX(57:112),7) iWri,(VPOCHA(JHD,j),j=iDEB,iFIN) 158 : ENDIF 159 : ELSE 160 : WRITE(ITEX(1:133),8) iWri,(VPOCHA(JHD,j),j=iDEB,iFIN) 161 : ENDIF 162 : ENDDO 163 : IDEBP=IFINP+1 164 : IFINP=(IL+1)*NPREF 165 : IFINP=MIN(NPOIN,IFINP) 166 : WRITE(IOIMP,10) ITEX 167 : ENDDO 168 : WRITE(IOIMP,9) 169 : iDEB=iFIN+1 170 : iFIN=(IE+1)*NCREF 171 : iFIN=MIN(NC,iFIN) 172 : ENDDO 173 : SEGDES,MELEME,MPOVAL,MSOUPO 174 : endif 175 : ENDDO 176 : WRITE(IOIMP,187) 177 : 178 : SEGSUP,idcp 179 : SEGDES,MCHPOI 180 : 181 : C DIFFERENTS FORMATS D'IMPRESSION 182 : 1 FORMAT(2X,4(15X,A4,5X)) 183 : 2 FORMAT(2X,2(15X,A4,11X,A4,5X)) 184 : 3 FORMAT(2X,2(15X,A4,11X,A4,11X,A4,5X)) 185 : 4 FORMAT(12X,8(5X,A4,6X)) 186 : 5 FORMAT(2X,I8,4X,1PE12.5) 187 : 6 FORMAT(2X,I8,4X,1PE12.5,3X,1PE12.5) 188 : 7 FORMAT(2X,I8,4X,1PE12.5,3X,1PE12.5,3X,1PE12.5) 189 : 8 FORMAT(2X,I8,3X,8(1X,1PE12.5,2X)) 190 : 9 FORMAT(/) 191 : 10 FORMAT(A132) 192 : 21 FORMAT(2X,4(15X,A4,1X,I4)) 193 : 22 FORMAT(2X,2(15X,A4,1X,I4,6X,A4,1X,I4)) 194 : 23 FORMAT(2X,2(15X,A4,1X,I4,6X,A4,1X,I4,6X,A4,1X,I4)) 195 : 24 FORMAT(12X,8(5X,A4,1X,I4)) 196 : 187 FORMAT(//) 197 : 198 : RETURN 199 : END 200 : 201 : 202 : 203 : 204 : 205 :
© Cast3M 2003 - All rights reserved.
Disclaimer