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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
SUBROUTINE TVELVC (nplot, IERROR)
C
C LATEST REVISION JULY, 1984
C
C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF
C SUBROUTINES VELVCT AND EZVEC.
C
C USAGE CALL TVELVC (IERROR)
C
C ARGUMENTS
C
C ON OUTPUT IERROR
C AN INTEGER VARIABLE
C =0 IF THERE IS A NORMAL EXIT FROM THE
C ROUTINES VELVCT AND EZVEC
C =1 OTHERWISE
C
C I/O IF THERE IS A NORMAL EXIT FROM THE ROUTINES
C VELVCT AND EZVEC THE MESSAGE
C VELVCT TEST SUCCESSFUL . . . SEE PLOTS TO
C VERIFY PERFORMANCE
C IS PRINTED.
C
C PRECISION SINGLE
C
C LANGUAGE FORTRAN
C
C HISTORY ORIGINALLY WRITTEN NOVEMBER 1976
C
C ALGORITHM ROUTINE TVELVC CALLS ROUTINES EZVEC AND
C VELVCT ONCE. EACH CALL PRODUCES A PLOT
C REPRESENTING A VECTOR FIELD. THE VECTOR
C FIELD IS OBTAINED FROM THE FUNCTION
C Z(X,Y) = X + Y + 1./((X-.1)**2+Y**2+.09)
C -1./((X+.1)**2+Y**2+.09),
C BY USING THE DIRECTION OF THE Z GRADIENT
C VECTORS AND THE LOGARITHM OF THE ABSOLUTE
C VALUE OF THE COMPONENTS.
C
C
C
C
DIMENSION U(21,25) ,V(21,25)
C
C SPECIFY COORDS FOR PLOT TITLES
C
DATA IX/94/,IY/1000/
C
C SPECIFY SOME OF THE ARGUMENTS IN VELVCT CALLING SEQUENCE
C
DATA FLO/0./,HI/0./,NSET/0/,LENGTH/0/,ISPV/0/,SPV/0./
C
C INITIALIZE ERROR PARAMETER
C
IERROR = 1
C
C SPECIFY VELOCITY FIELD FUNCTIONS U AND V
C
M = 21
N = 25
DO 20 I=1,M
X = .1*FLOAT(I-11)
DO 10 J=1,N
Y = .1*FLOAT(J-13)
DZDX = 1.-2.*(X-.10)/((X-.10)**2+Y**2+.09)**2+
1 2.*(X+.10)/((X+.10)**2+Y**2+.09)**2
DZDY = 1.-2.*Y/((X-.10)**2+Y**2+.09)**2+
1 2.*Y/((X+.10)**2+Y**2+.09)**2
UVMAG = ALOG(SQRT(DZDX*DZDX+DZDY*DZDY))
UVDIR = ATAN2(DZDY,DZDX)
U(I,J) = UVMAG*COS(UVDIR)
V(I,J) = UVMAG*SIN(UVDIR)
10 CONTINUE
20 CONTINUE
C
C CALL WTSTR FOR EZVEC PLOT TITLE
C
c +noao: flag used to plot either velvct or ezvec
if (nplot .eq. 1) then
CALL GQCNTN(IERR,ICN)
CALL GSELNT(0)
c X = PAU2FX(IX)
x = cpux (ix)
c Y = PAU2FY(IY)
y = cpuy (iy)
CALL WTSTR (X,Y,'DEMONSTRATION PLOT FOR ENTRY EZVEC OF VELVCT',
1 2,0,-1)
CALL GSELNT(ICN)
C
C CALL EZVEC FOR VELOCITY FIELD PLOT
C
CALL EZVEC (U,V,M,N)
endif
c -noao
C
C CALL VELVCT FOR VELOCITY FIELD PLOT
C
c +noao: flag used to plot either velvct or ezvec
if (nplot .eq. 2) then
CALL VELVCT (U,M,V,M,M,N,FLO,HI,NSET,LENGTH,ISPV,SPV)
C
C CALL WTSTR FOR VELVCT PLOT TITLE
C
CALL GQCNTN(IERR,ICN)
CALL GSELNT(0)
c X = PAU2FX(IX)
x = cpux (ix)
c Y = PAU2FY(IY)
y = cpuy (iy)
CALL WTSTR (X,Y,
1 'DEMONSTRATION PLOT FOR ENTRY VELVCT OF VELVCT',2,
2 0,-1)
CALL GSELNT(ICN)
endif
c -noao
c
c CALL NEWFM
C
IERROR = 0
c WRITE (6,1001)
RETURN
C
c1001 FORMAT (' VELVCT TEST SUCCESSFUL',24X,
c 1 'SEE PLOTS TO VERIFY PERFORMANCE')
C
END
|