aboutsummaryrefslogtreecommitdiff
path: root/sys/gio/ncarutil/tests/velvctt.f
blob: 36e22d2853575ab691e2e9cbf98f7396b7008cfa (plain) (blame)
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