Esope source files

   1 : C TRCISO    SOURCE    GOUNAND   13/10/21    21:15:36     7822           
   2 : CX  LABEL DES ISOVALEURS DANS LE CAS LIGNE
   3 : C   ON LE MET A L'INTERSECTION AVEC LE CONTOUR
   4 : C   ESPERONS QU'IL Y EN A UN
   5 : C     
   6 :       SUBROUTINE TRCISO(IPT1,VCPCHA,ICPR,XPROJ,NISO,VCHC,IVU)
   7 :       IMPLICIT INTEGER(I-N)
   8 :       SEGMENT ICPR(0)
   9 :       SEGMENT VCPCHA(XCOOR(/1)/(IDIM+1))
  10 :       SEGMENT XPROJ(3,ICPR(/1))
  11 :       SEGMENT IVU(ICPR(/1))
  12 :       CHARACTER*64 CHAIN
  13 :       REAL VCHC
  14 :       DIMENSION VCHC(*)
  15 : -INC CCOPTIO
  16 : -INC SMELEME
  17 : -INC SMCOORD
  18 : -INC CCTRACE
  19 :       DATA CHAIN /'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0
  20 :      >123456789&@'/
  20 :       CALL PRCOAP(IPT1,MELEME,ICPR,IVU,IRETOU)
  21 :       IF (IRETOU.EQ.0) RETURN
  22 :       IF (IERR.NE.0) RETURN
  23 : *  OK ON TIENT LE CONTOUR
  24 :       SEGACT MELEME
  25 :       DO 10 IEL=1,NUM(/2)
  26 :          DO 15 ISEG=1,NUM(/1)-1
  27 :             IPA=NUM(ISEG,IEL)
  28 :             IPB=NUM(ISEG+1,IEL)
  29 :             IPA=ICPR(IPA)
  30 :             IPB=ICPR(IPB)
  31 :             IF (IPA.EQ.0.OR.IPB.EQ.0) GOTO 15
  32 :             IF (IVU(IPA).LE.0.OR.IVU(IPB).LE.0) GOTO 15
  33 :             VA=VCPCHA(NUM(ISEG,IEL))
  34 :             VB=VCPCHA(NUM(ISEG+1,IEL))
  35 :             DO 20 ISO=1,NISO
  36 :                VCH=VCHC(ISO)
  37 :                IF (VA.LT.VCH.AND.VB.LT.VCH) GOTO 20
  38 :                IF (VA.GT.VCH.AND.VB.GT.VCH) GOTO 20
  39 :                DIFF=VB-VA
  40 :                IF (DIFF.EQ.0.) DIFF=1.
  41 :                XPAR=(VCH-VA)/DIFF
  42 :                XTR=XPROJ(1,IPA)+XPAR*(XPROJ(1,IPB)-XPROJ(1,IPA))
  43 :                YTR=XPROJ(2,IPA)+XPAR*(XPROJ(2,IPB)-XPROJ(2,IPA))
  44 :                if (niso.lt.13) then
  44 : *sg                     CALL CHCOUL(ICOTAB(ISO*(2-NISO/8)))
  44 :                   CALL CHCOUL(ICOTAB(ISOTA0(ISO,NISO)))
  45 :                else
  45 : *sg                  CALL CHCOUL(ISO)
  45 :                   CALL CHCOUL(ICOTAB(MOD(ISO,12)+1))
  46 :                endif
  46 :                CALL TRLABL(XTR,YTR,0.,CHAIN(ISO:ISO),1,0.15)
  47 :  20         CONTINUE
  48 :  15      CONTINUE
  49 :  10   CONTINUE
  50 :       SEGSUP MELEME
  51 :       RETURN
  52 :       END
  53 : 
  54 : 
  55 : 
  56 : 
  57 : 
  58 : 
  59 :