Télécharger otrini.eso

Retour à la liste

Numérotation des lignes :

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales