1 : C TRISO SOURCE GOUNAND 13/10/21 21:15:37 7822 2 : C 3 : SUBROUTINE TRISO(VCHC,XX,YY,ZZ,VV,NPT,NISO) 4 : C 5 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 6 : C C 7 : C TRACER DES ISOVALEURS D UN CHAMPOINT C 8 : C PAR COLORIAGE DE ZONE C 9 : C OU PAR TRACE DE LIGNE EN COULEUR (SELON ISOTYP C 10 : C C 11 : C C 12 : C AOUT 85 C 13 : C C 14 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 15 : C 16 : REAL VCHC 17 : C 18 : -INC CCOPTIO 19 : -INC CCREEL 20 : -INC CCGEOME 21 : -INC CCTRACE 22 : C 23 : PARAMETER (NTR=10) 24 : LOGICAL RANGE,IDEP 25 : DIMENSION VCHC(*),XTR(NTR),YTR(NTR),ZTR(NTR) 26 : dimension xx(*),yy(*),vv(*),zz(*),vvn(8) 27 : * 28 : * RANGE(XXX)= XXX.GE.-0.000001.AND.XXX.LE.1.000001 29 : RANGE(XXX)= XXX.GE.(-xszpre).AND.XXX.LE.(1.+xszpre) 30 : 31 : VSTART=-xsgran 32 : VFINAL= xsgran 33 : VALHAU=VSTART 34 : if (iogra.eq.6) then 35 : valbas=vchc(1) 36 : *goo valhau=vchc(niso) 37 : valhau=vchc(max(niso-1,1)) 38 : do 300 i=1,npt 39 : vvn(i)=(vv(i)-valbas)/(valhau-valbas) 40 : 300 continue 40 : call ogltriso(xx,yy,zz,vvn,npt) 41 : endif 42 : IF (ISOTYP.GT.0.and.iogra.ne.6) THEN 43 : DO 50 KK=1,NISO 44 : VALBAS=VALHAU 45 : VALHAU=VFINAL 46 : * IF (KK.NE.NISO) VALHAU=(VCHC(KK)+VCHC(KK+1))/2 47 : * TOLL=ABS(VCHC(min(niso,KK+1))-VCHC(max(1,KK-1)))/1e+2 48 : IF (KK.NE.NISO) VALHAU=VCHC(KK) 49 : * TOLL=ABS(VCHC(min(niso-1,KK+1))-VCHC(max(1,KK-1)))/1e+2 50 : TOLL=ABS(VCHC(min(niso-1,KK+1))-VCHC(max(1,KK-1)))*xszpre 51 : toll=max(xspeti,toll) 52 : NP=0 53 : C VALBAS ET VALHAU SONT LES FRONTIERES DE LA ZONE A COLORIER 54 : C JE CRAINS QU'IL FAILLE RECENSER LES CAS POSSIBLES 55 : C LE POINT EST IL DANS LA ZONE ? 56 : do 10 ipt=1,npt 57 : iptn=ipt+1 58 : if (iptn.gt.npt) iptn=1 59 : IF (VALBAS-toll.LE.VV(IPT).AND.VALHAU+toll.GE.VV(IPT)) 60 : $ THEN 61 : NP=NP+1 62 : if (npt.eq.2.and.np.gt.2) np=2 63 : XTR(NP)=XX(IPT) 64 : YTR(NP)=YY(IPT) 65 : ZTR(NP)=ZZ(IPT) 66 : ENDIF 67 : if (npt.eq.2.and.ipt.eq.2) goto 10 68 : C RENCONTRE-T-ON VALHAU OU VALBAS EN ALLANT VERS le point suivant 69 : vdiff=sign(max(toll,abs(vv(iptn)-vv(ipt))),vv(iptn) 70 : $ -vv(ipt)) 71 : UPOSH=(VALHAU-VV(ipt))/vdiff 72 : UPOSB=(VALBAS-VV(ipt))/vdiff 73 : UP=MIN(UPOSH,UPOSB) 74 : IF (RANGE(UP)) THEN 75 : NP=NP+1 76 : if (npt.eq.2.and.np.gt.2) np=2 77 : XTR(NP)=XX(ipt)+UP*(XX(iptn)-XX(ipt)) 78 : YTR(NP)=YY(ipt)+UP*(YY(iptn)-YY(ipt)) 79 : ZTR(NP)=ZZ(ipt)+UP*(ZZ(iptn)-ZZ(ipt)) 80 : ENDIF 81 : UP=MAX(UPOSH,UPOSB) 82 : IF (RANGE(UP)) THEN 83 : NP=NP+1 84 : if (npt.eq.2.and.np.gt.2) np=2 85 : XTR(NP)=XX(ipt)+UP*(XX(iptn)-XX(ipt)) 86 : YTR(NP)=YY(ipt)+UP*(YY(iptn)-YY(ipt)) 87 : ZTR(NP)=ZZ(ipt)+UP*(ZZ(iptn)-ZZ(ipt)) 88 : ENDIF 89 : C ON TRACE LE RESULTAT 90 : 10 continue 91 : IF (NP.NE.0) THEN 92 : if (niso.lt.16) then 92 : c CALL TRAISO(NP,XTR,YTR,ICOTAB(KK*(2-NISO/8))) 92 : CALL TRAISO(NP,XTR,YTR,ICOTAB(ISOTAB(KK,NISO))) 93 : else 93 : CALL TRAISO(NP,XTR,YTR,KK) 94 : endif 95 : ENDIF 96 : 50 CONTINUE 97 : IF (ISOTYP.EQ.2) THEN 97 : * call chcoul(8) 97 : call chcoul(IDNOIR) 98 : DO 250 KK=1,NISO-1 99 : * TOLL=ABS(VCHC(min(niso,KK+1))-VCHC(max(1,KK-1)))/1e+3 100 : * VALDES = (VCHC(KK)+VCHC(KK+1))/2 101 : * TOLL=ABS(VCHC(min(niso-1,KK+1))-VCHC(max(1,KK-1)))/1e+3 102 : TOLL=ABS(VCHC(min(niso-1,KK+1))-VCHC(max(1,KK-1)))*xszpre 103 : VALDES = VCHC(KK) 104 : IDEP=.TRUE. 105 : do 220 ipt=1,npt 106 : iptn=ipt+1 107 : if (iptn.gt.npt) iptn=1 108 : UPOS=-1. 109 : IF (ABS(VV(iptn)-VV(ipt)).GT.TOLL) 110 : * UPOS=(VALDES-VV(ipt))/(VV(iptn)-VV(ipt)) 111 : IF (RANGE(UPOS)) THEN 112 : IF (IDEP) THEN 113 : XTR(1)=XX(ipt)+UPOS*(XX(iptn)-XX(ipt)) 114 : YTR(1)=YY(ipt)+UPOS*(YY(iptn)-YY(ipt)) 115 : ZTR(1)=ZZ(ipt)+UPOS*(ZZ(iptn)-ZZ(ipt)) 116 : IDEP=.FALSE. 117 : ELSE 118 : XTR(2)=XX(ipt)+UPOS*(XX(iptn)-XX(ipt)) 119 : YTR(2)=YY(ipt)+UPOS*(YY(iptn)-YY(ipt)) 120 : ZTR(2)=ZZ(ipt)+UPOS*(ZZ(iptn)-ZZ(ipt)) 120 : CALL POLRL(2,XTR,YTR,ZTR) 121 : * GOTO 150 122 : ENDIF 123 : ENDIF 124 : 220 continue 125 : 250 CONTINUE 126 : ENDIF 127 : ELSEIF (iogra.ne.6) THEN 128 : DO 150 KK=1,NISO 129 : * TOLL=ABS(VCHC(min(niso,KK+1))-VCHC(max(1,KK-1)))/1e+3 130 : TOLL=ABS(VCHC(min(niso,KK+1))-VCHC(max(1,KK-1)))*xszpre 131 : VALDES = VCHC(KK) 132 : IDEP=.TRUE. 133 : do 20 ipt=1,npt 134 : iptn=ipt+1 135 : if (iptn.gt.npt) iptn=1 136 : UPOS=-1. 137 : IF (ABS(VV(iptn)-VV(ipt)).GT.TOLL) 138 : * UPOS=(VALDES-VV(ipt))/(VV(iptn)-VV(ipt)) 139 : IF (RANGE(UPOS)) THEN 140 : IF (IDEP) THEN 141 : if (niso.lt.13) then 142 : *sg if (niso.lt.16) then 142 : *sg CALL CHCOUL(ICOTAB(KK*(2-NISO/8))) 142 : CALL CHCOUL(ICOTAB(ISOTA0(KK,NISO))) 143 : else 143 : CALL CHCOUL(ICOTAB(MOD(KK,12)+1)) 143 : *sg CALL CHCOUL(KK) 144 : endif 145 : XTR(1)=XX(ipt)+UPOS*(XX(iptn)-XX(ipt)) 146 : YTR(1)=YY(ipt)+UPOS*(YY(iptn)-YY(ipt)) 147 : ZTR(1)=ZZ(ipt)+UPOS*(ZZ(iptn)-ZZ(ipt)) 148 : IDEP=.FALSE. 149 : ELSE 150 : XTR(2)=XX(ipt)+UPOS*(XX(iptn)-XX(ipt)) 151 : YTR(2)=YY(ipt)+UPOS*(YY(iptn)-YY(ipt)) 152 : ZTR(2)=ZZ(ipt)+UPOS*(ZZ(iptn)-ZZ(ipt)) 152 : CALL POLRL(2,XTR,YTR,ZTR) 153 : * GOTO 150 154 : ENDIF 155 : ENDIF 156 : 20 continue 157 : 150 CONTINUE 158 : ENDIF 159 : RETURN 160 : END 161 : 162 : 163 : 164 : 165 : 166 : 167 : 168 : 169 : 170 : 171 : 172 : 173 : 174 : 175 : 176 :
© Cast3M 2003 - All rights reserved.
Disclaimer