1 SUBROUTINE FILM(NRALEN,NBTOUR,IBOUNCE,IFILM,NUMPT,NUMANI 2 & ,XX,LXX,NDX,YY,LYY,NDY,XX0,YY0) 3C 4 INCLUDE 'param.f' 5 REAL*8 XX(*),YY(*) 6 LOGICAL*4 LXX(*),LYY(*) 7C 8 CHARACTER*10 COMPT 9 CALL GSLT(0) 10 CALL GSLW(1) 11 CALL GSLSS(1) 12 CALL GSPATF(0) 13 CALL GSPAT(16) 14 CALL ASFCOL(4) 15C 16 IF (IFILM.GE.2) THEN 17 XCOM = XMIN+.01*(XMAX-XMIN) 18 YCOM = YMIN+.01*(YMAX-YMIN) 19 ELSE 20 XCOM = XX0+.01*(XMAX-XMIN) 21 YCOM = YY0+.01*(YMAX-YMIN) 22 ENDIF 23 IF (NRALEN.GT.0) TEMPSAPERDRE = REAL(NRALEN)*0.001 24 CALL GSCOL(7) 25 CALL METS_CURSEUR(.5*(XMIN+XMAX),.5*(YMIN+YMAX)) 26 IF (IFILM.EQ.1) THEN 27 CALL VRAIECOORD(XMIN,YMAX,IX0,IY0) 28 CALL VRAIECOORD(XMAX,YMIN,IX1,IY1) 29 ILARG = IX1-IX0 30 IHAUT = IY1-IY0 31 IX0 = IX0+1 32 IX1 = IX1-1 33 IY0 = IY0+1 34 IY1 = IY1-1 35 ILARG = ILARG-2 36 IHAUT = IHAUT-2 37 DO ITOUR=1,NBTOUR 38 CALL ASFCOL(4) 39 WRITE(COMPT(1:3),'(I2,":")') ITOUR 40 DO IC=1,NCOURB 41 WRITE(COMPT(4:7),'(I4)') IC 42 CALL GSBND(XX0,XMAX,YY0,YMAX) 43 CALL GSCHAR2(XCOM,YCOM,7,COMPT) 44 CALL TRACE2(IC,IX0,IX1,IY0,IY1,ILARG,IHAUT 45 & ,XX,LXX,NDX,YY,LYY,NDY) 46 IF (NRALEN.GT.0) CALL PERDDUTEMPS(TEMPSAPERDRE) 47 ENDDO 48 IF (IBOUNCE.EQ.1) THEN 49 CALL ASFCOL(1) 50 DO IC=NCOURB,1,-1 51 WRITE(COMPT(4:7),'(I4)') IC 52 CALL GSBND(XX0,XMAX,YY0,YMAX) 53 CALL GSCHAR2(XCOM,YCOM,7,COMPT) 54 CALL TRACE2(IC,IX0,IX1,IY0,IY1,ILARG,IHAUT 55 & ,XX,LXX,NDX,YY,LYY,NDY) 56 IF (NRALEN.GT.0) CALL PERDDUTEMPS(TEMPSAPERDRE) 57 ENDDO 58 ENDIF 59 ENDDO 60 ELSE 61 DO ITOUR=1,NBTOUR 62 WRITE(COMPT(1:3),'(I2,":")') ITOUR 63 ICOMP = 0 64 IF (NUMPT.GT.0) THEN 65 CALL GSMIX(1) 66 DO IC=1,NCOURB 67 IF (IMONO.EQ.1) THEN 68 ICOLOR = ICOL(IC) 69 CALL GSCOL(ICOLOR) 70 ENDIF 71 CALL GSLW(IGROS+IEPL(IC)) 72 IREACH(IC) = MAX(2,MIN(NUMPT,NPOINT(IC))) 73 ICOMP = MAX(ICOMP,IREACH(IC)) 74 CALL GSPLNE_SPEED(IREACH(IC),XPOINT(NDEB(IC)+1) 75 & ,YPOINT(NDEB(IC)+1)) 76 ENDDO 77 ELSE 78 DO IC=1,NCOURB 79 IREACH(IC) = 1 80 ENDDO 81 ENDIF 82 IFINI = 1 83 1000 CALL GSCOL(7) 84 WRITE(COMPT(4:9),'(I6)') ICOMP 85 CALL GSCHAR2(XCOM,YCOM,9,COMPT) 86 CALL GSLW(IGROS-1) 87 IF (NRALEN.GT.0) CALL PERDDUTEMPS(TEMPSAPERDRE) 88 IF (IFINI.NE.0) THEN 89 IFINI = 0 90 ICOMP = 0 91 DO IC=1,NCOURB 92 IF (IMONO.EQ.1) THEN 93 ICOLOR = ICOL(IC) 94 CALL GSCOL(ICOLOR) 95 ENDIF 96 CALL GSLW(IGROS+IEPL(IC)) 97 NP = MIN(NUMANI,NPOINT(IC)-IREACH(IC))+1 98 IF (NP.GT.1) THEN 99 CALL GSPLNE_SPEED(NP,XPOINT(IREACH(IC)+NDEB(IC)) 100 & ,YPOINT(IREACH(IC)+NDEB(IC))) 101 IF (NUMPT.GT.0) THEN 102 ID = IREACH(IC)-NUMPT+1 103 CALL GSMIX(1) 104 CALL GSPLNE_SPEED(NP,XPOINT(ID+NDEB(IC)) 105 & ,YPOINT(ID+NDEB(IC))) 106 CALL GSMOVE(XPOINT(ID+NDEB(IC)),YPOINT(ID+NDEB(IC))) 107 CALL GSLINE(XPOINT(ID+NDEB(IC)),YPOINT(ID+NDEB(IC))) 108 CALL GSMIX(0) 109 ENDIF 110 IREACH(IC) = IREACH(IC)+NP-1 111 ICOMP = MAX(ICOMP,IREACH(IC)) 112 IF (IREACH(IC).LT.NPOINT(IC)) IFINI = 1 113 ENDIF 114 ENDDO 115 GOTO 1000 116 ENDIF 117 CALL GSMIX(1) 118 IF (IBOUNCE.EQ.0) THEN 119 DO IC=1,NCOURB 120 IF (IMONO.EQ.1) THEN 121 ICOLOR = ICOL(IC) 122 CALL GSCOL(ICOLOR) 123 ENDIF 124 CALL GSLW(IGROS+IEPL(IC)) 125 IF (NUMPT.EQ.0) THEN 126 CALL GSPLNE_SPEED(NPOINT(IC),XPOINT(1+NDEB(IC)) 127 & ,YPOINT(1+NDEB(IC))) 128 ELSE 129 NP = MAX(2,MIN(NUMPT,NPOINT(IC))) 130 II = NPOINT(IC)-NP+1 131 CALL GSPLNE_SPEED(NP,XPOINT(II+NDEB(IC)) 132 & ,YPOINT(II+NDEB(IC))) 133 ENDIF 134 ENDDO 135 ELSE 136 IFINI = 1 137 2000 CALL GSMIX(0) 138 CALL GSCOL(7) 139 WRITE(COMPT(4:9),'(I6)') ICOMP 140 CALL GSCHAR2(XCOM,YCOM,9,COMPT) 141 CALL GSLW(IGROS-1) 142 IF (NRALEN.GT.0) CALL PERDDUTEMPS(TEMPSAPERDRE) 143 CALL GSMIX(1) 144 IF (IFINI.NE.0) THEN 145 IFINI = 0 146 ICOMP = 0 147 DO IC=1,NCOURB 148 IF (IMONO.EQ.1) THEN 149 ICOLOR = ICOL(IC) 150 CALL GSCOL(ICOLOR) 151 ENDIF 152 CALL GSLW(IGROS+IEPL(IC)) 153 NP = MIN(NUMANI,IREACH(IC))+1 154 IF (NP.GT.1) THEN 155 ID = IREACH(IC)-NP+1 156 CALL GSPLNE_SPEED(NP,XPOINT(ID+NDEB(IC)) 157 & ,YPOINT(ID+NDEB(IC))) 158 CALL GSMOVE(XPOINT(IREACH(IC)+NDEB(IC)) 159 & ,YPOINT(IREACH(IC)+NDEB(IC))) 160 CALL GSLINE(XPOINT(IREACH(IC)+NDEB(IC)) 161 & ,YPOINT(IREACH(IC)+NDEB(IC))) 162 IF (NUMPT.GT.0) THEN 163 ID = IREACH(IC)-NUMPT+1 164 CALL GSMIX(0) 165 CALL GSPLNE_SPEED(NP,XPOINT(ID+NDEB(IC)) 166 & ,YPOINT(ID+NDEB(IC))) 167 CALL GSMOVE(XPOINT(ID+NDEB(IC)) 168 & ,YPOINT(ID+NDEB(IC))) 169 CALL GSLINE(XPOINT(ID+NDEB(IC)) 170 & ,YPOINT(ID+NDEB(IC))) 171 CALL GSMIX(1) 172 ENDIF 173 IREACH(IC) = IREACH(IC)-NP+1 174 ICOMP = MAX(ICOMP,IREACH(IC)) 175 IF (IREACH(IC).GT.0) IFINI = 1 176 ENDIF 177 ENDDO 178 GOTO 2000 179 ENDIF 180 ENDIF 181 CALL GSMIX(0) 182 ENDDO 183 ENDIF 184C 185 END 186C----------------------------------------------------------------------- 187 SUBROUTINE TRACE2(ICOURB,IX0,IX1,IY0,IY1,ILARG,IHAUT 188 & ,XX,LXX,NDX,YY,LYY,NDY) 189 INCLUDE 'param.f' 190 REAL*8 XX(*),YY(*) 191 LOGICAL*4 LXX(*),LYY(*) 192C 193 CALL GSPROGRE(1) 194 CALL x11effacepix 195 CALL GSBND(XMIN,XMAX,YMIN,YMAX) 196 IF (IQUADR.LT.0) CALL AXES(XX,LXX,NDX,YY,LYY,NDY,0,0) 197 IF (ILT(1).GE.0) THEN 198 CALL GSCOL(ICOL(1)) 199 CALL GSLW(IGROS+IEPL(1)) 200 CALL GSLT(ILT(1)) 201 CALL GSPLNE_SPEED(NPOINT(ICOURB),XPOINT(1+NDEB(ICOURB)) 202 & ,YPOINT(1+NDEB(ICOURB))) 203 ENDIF 204 IF (NMARK(1).GT.0) THEN 205 CALL GSCOL(ICOLM(1)) 206 CALL GSMS(NMARK(1)) 207 CALL GSMB(TM(1)*XMB,TM(1)*YMB) 208 CALL GSMRKS(NPOINT(ICOURB),XPOINT(1+NDEB(ICOURB)) 209 & ,YPOINT(1+NDEB(ICOURB))) 210 ENDIF 211 CALL AXES(XX,LXX,NDX,YY,LYY,NDY,1,1) 212 CALL GSPROGRE(0) 213 CALL x11metrect2(IX0,IY0,ILARG,IHAUT,IX0,IY0) 214 CALL viderbuff2() 215 IF (ILT(1).NE.0) CALL GSLT(0) 216 END 217C-------------------------------------------------------------------- 218 SUBROUTINE GENERIQUE(NRALEN,XCOM,YCOM) 219C 220 INCLUDE 'param.f' 221C 222 CHARACTER*6 COMPT 223C 224 NRALEN2 = NRALEN*NCOURB 225 CALL GSCOL(4) 226 COMPT = ' 1' 227 CALL GSCHAR2(XCOM,YCOM,6,COMPT) 228 DO K=1,NRALEN2 229 CALL GSPLNE_SPEED(NPOINT(1),XPOINT(1),YPOINT(1)) 230 ENDDO 231 WRITE(COMPT,'("1/",I4)') NCOURB 232 CALL GSCHAR2(XCOM,YCOM,6,COMPT) 233 DO K=1,NRALEN2 234 CALL GSPLNE_SPEED(NPOINT(NCOURB),XPOINT(1+NDEB(NCOURB)) 235 & ,YPOINT(1+NDEB(NCOURB))) 236 ENDDO 237 CALL GSCOL(0) 238 WRITE(COMPT,'(I6)') NCOURB 239 CALL GSCHAR2(XCOM,YCOM,6,COMPT) 240 DO K=1,NRALEN2 241 CALL GSPLNE_SPEED(NPOINT(1),XPOINT(1),YPOINT(1)) 242 ENDDO 243 DO K=1,NRALEN2 244 CALL GSPLNE_SPEED(NPOINT(NCOURB),XPOINT(1+NDEB(NCOURB)) 245 & ,YPOINT(1+NDEB(NCOURB))) 246 ENDDO 247 CALL GSCOL(4) 248 COMPT = ' 1' 249 CALL GSCHAR2(XCOM,YCOM,6,COMPT) 250 DO K=1,NRALEN2 251 CALL GSPLNE_SPEED(NPOINT(1),XPOINT(1),YPOINT(1)) 252 ENDDO 253 END 254