1 : C OTRINI SOURCE CHAT 11/09/20 21:15:29 7135 2 : CSSP TRINIT VERSION 04/08/89 MODIFIEE POUR DRIVER OPENGL+GLUT 3 : C------------------------------------------------------------ 4 : SUBROUTINE OTRINI(NOL,AXAX,AYAY,TITRE,HAUTT,VALEU,NCOUMA,IPOLI, 5 : & ICOSC) 6 : save niso 7 : dimension ztrl(10),ctrl(10) 8 : dimension xtr(64),ytr(64),ztr(64) 9 : dimension xl(3),yl(3),zl(3) 10 : character*(*) titre,reply,prompt 11 : INTEGER valeu,len,ncouma,ipoli,icosc 12 : logical fenet 13 : external long 14 : CHARACTER*80 CHAINE,CHMESS 15 : EQUIVALENCE (CHAINE,ICHAIN) 16 : EQUIVALENCE (CHmess,ICHmes) 17 : NCOUMA=64 18 : HAUT=HAUTT 19 : NHAUT=31 20 : VALEUR=VALEU 21 : KSEGN=0 22 : AX=AXAX 23 : AY=AYAY 24 : len=long(titre) 24 : call oglini(titre,valeu,len,ncouma,ipoli,icosc) 25 : RETURN 26 : C*********************************************************************** 27 : 28 : C 29 : C subroutine DFENET 30 : C 31 : ENTRY ODFENE(XMIN,XXAX,YMIN,YYAX,ZMIN,ZZAX,XR1,XR2,YR1,YR2,FENET) 32 : xr1=xmin 33 : xr2=xxax 34 : yr1=ymin 35 : yr2=yyax 35 : call ogldfene(XMIN,XXAX,YMIN,YYAX,ZMIN,ZZAX,FENET) 36 : RETURN 37 : C*********************************************************************** 38 : C 39 : C subroutine TRLABL 40 : C 41 : ENTRY OTRLAB(X,Y,Z,CARACT,NCAR,HAUTT) 41 : call ogltrlabl(x,y,z,caract,ncar) 42 : RETURN 43 : C*********************************************************************** 44 : 45 : C 46 : C subroutine TRBOX 47 : C 48 : * ENTRY PTRBOX (HAUTX,HAUTY) 49 : RETURN 50 : C*********************************************************************** 51 : C 52 : C subroutine CHCOUL 53 : C 54 : ENTRY OCHCOU(JCOLO) 54 : call oglchcou(jcolo) 55 : RETURN 56 : C*********************************************************************** 57 : 58 : C 59 : C subroutine FVALIS 60 : C 61 : ENTRY OFVALI(IFENI,IRESU,NH,ni) 62 : * write (6,*) ' ofvali-1 ni ',ni 62 : call oglfvali(ifeni,iresu,nh) 63 : * write (6,*) ' ofvali-2 ni ',ni 64 : 65 : niso=ni 66 : RETURN 67 : C*********************************************************************** 68 : 69 : C 70 : C subroutine MENU 71 : C 72 : *PV ENTRY PMENU(LEGEND,NCASE,LLONG) 73 : RETURN 74 : C*********************************************************************** 75 : C 76 : C subroutine INSEGT 77 : C 78 : ENTRY OINSEG(NBSEGT,IRESS) 78 : call oglinsegt(nbsegt,iress) 79 : RETURN 80 : C*********************************************************************** 81 : 82 : C 83 : C subroutine POLRL 84 : C 85 : ENTRY OPOLRL(NTRSTU,XTR,YTR,ZTR) 85 : call oglpolrl(ntrstu,xtr,ytr,ztr) 86 : 87 : 88 : 89 : 90 : RETURN 91 : C*********************************************************************** 92 : 93 : C 94 : C subroutine TRDIG 95 : C 96 : *pv ENTRY PTRDIG(X,Y,INCLE) 97 : RETURN 98 : C*********************************************************************** 99 : C 100 : C subroutine TRFACE 101 : C 102 : ENTRY OTRFAC(NP,XTR,YTR,ZTR,ZN,ICOLE,IEFF) 103 : * comme opengl ne veut que des polygones convexes, on découpe en triangles 104 : npl=np 105 : if ((xtr(1).eq.xtr(np)).and.(ytr(1).eq.ytr(np)).and. 106 : > (ztr(1).eq.ztr(np))) npl=np-1 107 : if (npl.eq.3) then 108 : nt=1 109 : xc=xtr(3) 110 : yc=ytr(3) 111 : zc=ztr(3) 112 : elseif (npl.eq.4) then 113 : nt=4 114 : xc=(xtr(1)+xtr(2)+xtr(3)+xtr(4))/4 115 : yc=(ytr(1)+ytr(2)+ytr(3)+ytr(4))/4 116 : zc=(ztr(1)+ztr(2)+ztr(3)+ztr(4))/4 117 : elseif (npl.eq.6) then 118 : nt=6 119 : xc=(xtr(2)+xtr(4)+xtr(6))/3 120 : yc=(ytr(2)+ytr(4)+ytr(6))/3 121 : zc=(ztr(2)+ztr(4)+ztr(6))/3 122 : elseif (npl.eq.8) then 123 : nt=8 124 : xc=-0.25*xtr(1)+0.5*xtr(2)-0.25*xtr(3)+0.5*xtr(4)- 125 : > 0.25*xtr(5)+0.5*xtr(6)-0.25*xtr(7)+0.5*xtr(8) 126 : yc=-0.25*ytr(1)+0.5*ytr(2)-0.25*ytr(3)+0.5*ytr(4)- 127 : > 0.25*ytr(5)+0.5*ytr(6)-0.25*ytr(7)+0.5*ytr(8) 128 : zc=-0.25*ztr(1)+0.5*ztr(2)-0.25*ztr(3)+0.5*ztr(4)- 129 : > 0.25*ztr(5)+0.5*ztr(6)-0.25*ztr(7)+0.5*ztr(8) 130 : else 131 : xc=0 132 : yc=0 133 : zc=0 134 : do ipl=1,npl 135 : xc=xc+xtr(ipl) 136 : yc=yc+ytr(ipl) 137 : zc=zc+ztr(ipl) 138 : enddo 139 : xc=xc/npl 140 : yc=yc/npl 141 : zc=zc/npl 142 : endif 143 : xl(1)=xc 144 : yl(1)=yc 145 : zl(1)=zc 145 : call oglchcou(icole) 146 : do it=1,nt 147 : iu=it+1 148 : if (iu.gt.npl) iu=1 149 : xl(2)=xtr(it) 150 : yl(2)=ytr(it) 151 : zl(2)=ztr(it) 152 : xl(3)=xtr(iu) 153 : yl(3)=ytr(iu) 154 : zl(3)=ztr(iu) 154 : call ogltrfac(3,xl,yl,zl) 155 : enddo 156 : ieff=1 157 : RETURN 158 : C*********************************************************************** 159 : C 160 : C subroutine TRAISO 161 : C 162 : ENTRY OTRAIS(NP,XTR,YTR,ICOLE) 163 : do ii=1,10 164 : ztrl(ii)=0 165 : ctrl(ii)=(icole-1.)/niso 166 : enddo 166 : call ogltriso(xtr,ytr,ztrl,ctrl,np) 166 : * call ogltrfac(np,xtr,ytr,ztrl) 167 : RETURN 168 : C*********************************************************************** 169 : 170 : C 171 : C subroutine TREFF 172 : C 173 : *PV ENTRY PTREFF 174 : 1160 CONTINUE 175 : RETURN 176 : C*********************************************************************** 177 : C 178 : C subroutine TRAFF 179 : C 180 : ENTRY OTRAFF(ICLE) 181 : ICLE=0 181 : call oglaff(icle) 182 : RETURN 183 : C*********************************************************************** 184 : C 185 : C subroutine TRMFIN 186 : C 187 : *PV ENTRY PTRMFI 188 : RETURN 189 : C*********************************************************************** 190 : 191 : C 192 : C subroutine ZOOM 193 : C 194 : * ENTRY PZOOM(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA) 195 : *pv ENTRY PZOOM(IZOOM,XMI,XMA,YMI,YMA) 196 : RETURN 197 : C*********************************************************************** 198 : 199 : C 200 : C subroutine CHANG 201 : C 202 : ENTRY OCHANG(IRESU,ISORT,ICHANG,JSEG) 202 : call oglchang(IRESU,ISORT,ICHANG,JSEG) 203 : RETURN 204 : C*********************************************************************** 205 : 206 : C 207 : C subroutine INI 208 : C 209 : *pv ENTRY PINI(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA) 210 : RETURN 211 : C*********************************************************************** 212 : 213 : C 214 : C subroutine FLGI 215 : C 216 : *pv ENTRY PFLGJ 217 : RETURN 218 : C*********************************************************************** 219 : 220 : C 221 : C subroutine IMPR 222 : C 223 : *pv ENTRY PFLGI 224 : ENTRY OIMPR 225 : C 226 : RETURN 227 : C*********************************************************************** 228 : 229 : C 230 : C subroutine VAL 231 : C 232 : *pv ENTRY PVAL(IRESU,ISORT,NISO) 233 : C 234 : C*********************************************************************** 235 : 236 : C 237 : C subroutine MAJSEG 238 : C 239 : ENTRY OMAJSE(IMAJ,IRESU,IQUALI,INUMNO,INUMEL) 239 : call oglmajse(imaj,iresu,iquali,inumno,inumel) 240 : C 241 : RETURN 242 : C*********************************************************************** 243 : C 244 : entry OTRMES(titre ) 244 : call ogltrmess(titre ,LONG(titre )) 245 : C 246 : RETURN 247 : C*********************************************************************** 248 : C 249 : C subroutine TRGET 250 : C 251 : C ----------------------------------------- 252 : C Sous-programme uniquement appele par MODI 253 : C ----------------------------------------- 254 : ENTRY OTRGET(PROMPT,REPLY) 255 : LPROMP=LONG(PROMPT) 256 : LREPLY=LONG(REPLY) 257 : CHAINE=PROMPT 257 : CALL oglGET(ICHAIN,LPROMP,ICHAIN,LREPLY) 258 : REPLY=' ' 259 : IF (LREPLY.NE.0) REPLY=CHAINE(1:LREPLY) 260 : RETURN 261 : 262 : RETURN 263 : C ------------ 264 : C fin de TRGET 265 : C ------------ 266 : END 267 : 268 : 269 : 270 : 271 :
© Cast3M 2003 - All rights reserved.
Disclaimer