Sources Esope | Cast3M

trciso
C TRCISO    SOURCE    PV        20/03/30    21:25:24     10567          
CX  LABEL DES ISOVALEURS DANS LE CAS LIGNE
C   ON LE MET A L'INTERSECTION AVEC LE CONTOUR
C   ESPERONS QU'IL Y EN A UN
C
      SUBROUTINE TRCISO(IPT1,VCPCHA,ICPR,XPROJ,NISO,VCHC,IVU)
      IMPLICIT INTEGER(I-N)
      SEGMENT ICPR(0)
      SEGMENT VCPCHA(nbpts)
      SEGMENT XPROJ(3,ICPR(/1))
      SEGMENT IVU(ICPR(/1))
      CHARACTER*64 CHAIN
      REAL VCHC
      DIMENSION VCHC(*)
 
-INC PPARAM
-INC CCOPTIO
-INC SMELEME
-INC SMCOORD
-INC CCTRACE
      DATA CHAIN /'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0
     >123456789&@'/
      CALL PRCOAP(IPT1,MELEME,ICPR,IVU,IRETOU)
      IF (IRETOU.EQ.0) RETURN
      IF (IERR.NE.0) RETURN
*  OK ON TIENT LE CONTOUR
      SEGACT MELEME
      DO 10 IEL=1,NUM(/2)
         DO 15 ISEG=1,NUM(/1)-1
            IPA=NUM(ISEG,IEL)
            IPB=NUM(ISEG+1,IEL)
            IPA=ICPR(IPA)
            IPB=ICPR(IPB)
            IF (IPA.EQ.0.OR.IPB.EQ.0) GOTO 15
            IF (IVU(IPA).LE.0.OR.IVU(IPB).LE.0) GOTO 15
            VA=VCPCHA(NUM(ISEG,IEL))
            VB=VCPCHA(NUM(ISEG+1,IEL))
            DO 20 ISO=1,NISO
               VCH=VCHC(ISO)
               IF (VA.LT.VCH.AND.VB.LT.VCH) GOTO 20
               IF (VA.GT.VCH.AND.VB.GT.VCH) GOTO 20
               DIFF=VB-VA
               IF (DIFF.EQ.0.) DIFF=1.
               XPAR=(VCH-VA)/DIFF
               XTR=XPROJ(1,IPA)+XPAR*(XPROJ(1,IPB)-XPROJ(1,IPA))
               YTR=XPROJ(2,IPA)+XPAR*(XPROJ(2,IPB)-XPROJ(2,IPA))
               if (niso.lt.13) then
*sg                     CALL CHCOUL(ICOTAB(ISO*(2-NISO/8)))
                  CALL CHCOUL(ICOTAB(ISOTA0(ISO,NISO)))
               else
*sg                  CALL CHCOUL(ISO)
                  CALL CHCOUL(ICOTAB(MOD(ISO,12)+1))
               endif
               CALL TRLABL(XTR,YTR,0.,CHAIN(ISO:ISO),1,0.15)
 20         CONTINUE
 15      CONTINUE
 10   CONTINUE
      SEGSUP MELEME
      RETURN
      END