File: uspk11.f

package info (click to toggle)
dcl 7.5.2-2
  • links: PTS, VCS
  • area: main
  • in suites:
  • size: 21,008 kB
  • sloc: fortran: 48,433; f90: 12,803; ansic: 6,513; makefile: 4,738; ruby: 184; sh: 153
file content (67 lines) | stat: -rw-r--r-- 1,602 bytes parent folder | download | duplicates (14)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
*-----------------------------------------------------------------------
      PROGRAM USPK11

      PARAMETER(N=181, N1=26, N2=7, NC=4)
      REAL T(N), Y(N), UX1(N1), UX2(N2)
      DOUBLE PRECISION R, A
      CHARACTER*(NC) CH(N2)

      DATA CH  /'JAN', 'FEB', 'MAR', 'APL', 'JUN', 'JULY', '   '/
      DATA UX2 /   0.,   31.,   59.,   90.,  120.,   151.,  181./

      R = 0.2D0
      A = 4.D0
      Y(1) = 120.
      T(1) = 0.5
      DO 10 I=2, N
        R = A*R*(1.D0-R)
        Y(I) = Y(I-1) + (R-0.46)*2
        T(I) = I - 0.5
   10 CONTINUE

      DO 20 I=1, N1
        UX1(I) = (I-1)*7 + 1
   20 CONTINUE

*-----------------------------------------------------------------------

      WRITE(*,*) ' WORKSTATION ID (I)  ? ;'
      CALL SGPWSN
      READ (*,*) IWS

      CALL GLRGET('RUNDEF',RUNDEF)

      CALL USLSET('LYINV',.TRUE.)

      CALL GROPN(IWS)
      CALL GRFRM

      CALL GRSWND(0., 181., RUNDEF, RUNDEF)
      CALL GRSVPT(0.2, 0.8, 0.2, 0.8)
      CALL GRSTRN(1)

      CALL USSPNT(N, RUNDEF, Y)
      CALL USPFIT

      CALL GRSTRF

*------------------------------- Y-AXIS --------------------------------

      CALL USYAXS('L')
      CALL USYAXS('R')
      CALL UYSTTL('L', 'YEN/DOLLAR', 0.)

*------------------------------- X-AXIS --------------------------------

      CALL UZLSET('LBTWN', .TRUE.)
      CALL UXAXLB('B', UX1, N1, UX2, CH, NC, N2)
      CALL UXAXLB('T', UX1, N1, UX2, CH, NC, N2)
      CALL UXSTTL('T', 'EXCHANGE RATE', 0.)

*-------------------------------- LINE ---------------------------------

      CALL SGPLU(N, T, Y)

      CALL GRCLS

      END