W2GUV.inc
References to this file elsewhere.
1 SUBROUTINE W2GUV
2 I(MEND1,NEND1,JEND1 ,MNWAV,IMAX,JMAX,IMX ,JMAXHF,KMAX,
3 I IFAX ,TRIGS,SINCLT,ER ,PNM ,DPNM,QROT,QDIV,
4 O GU ,GV ,
5 W GWRK)
6 C
7 C...GU,GV IS NOT PSEUDO WIND,9.5.NOT MULTIPLIED BY SINCLT
8 C
9 DIMENSION QROT(2,KMAX,MNWAV),QDIV(2,KMAX,MNWAV)
10
11 c990408
12 c DIMENSION IFAX(10),TRIGS(500)
13 DIMENSION IFAX(10),TRIGS(IMAX)
14 C...WARNING: THE DIMENSION OF GU,GV,GWRK SHOULD BE .GE. IMX*JMAX*KMAX
15 C IMX=IMAX+2
16 DIMENSION GU (IMAX,JMAX,KMAX),GV (IMAX,JMAX,KMAX)
17 DIMENSION GWRK(IMAX,JMAX,KMAX)
18 DIMENSION PNM (MNWAV,JMAXHF) ,DPNM(MNWAV,JMAXHF)
19 DIMENSION SINCLT(JMAX)
20 C
21 C...CONVERSION TO PSI & CHI
22 ERSQ =ER*ER
23 ERSQIV=1.0/ERSQ
24 L=0
25 DO 200 M=1,MEND1
26 NMAX=MIN(NEND1,JEND1+1-M)
27 NMIN=1
28 IF(M.EQ.1) NMIN=2
29 DO 220 N=NMIN,NMAX
30 AN =N+M-2
31 FNN1=-ERSQ/( AN*(AN+1.0) )
32 *vdir loopcnt=200
33 DO 220 K=1,2
34 DO 220 K1=1,KMAX
35 QROT(K,K1,L+N)=FNN1*QROT(K,K1,L+N)
36 QDIV(K,K1,L+N)=FNN1*QDIV(K,K1,L+N)
37 220 CONTINUE
38 L=L+NMAX
39 200 CONTINUE
40 C
41 CALL LGNUV
42 I(MEND1,NEND1,JEND1,MNWAV,IMAX,JMAX,JMAXHF,KMAX,PNM,DPNM,QROT,QDIV,
43 O GU ,GV ,
44 W GWRK)
45 LOT=JMAX*KMAX
46 CALL FFT991(GU,TRIGS,IFAX,1,IMX,IMAX,LOT,1)
47 CALL FFT991(GV,TRIGS,IFAX,1,IMX,IMAX,LOT,1)
48 C CALL FFT991(GU ,GWRK,TRIGS,IFAX,1,IMX,IMAX,LOT,1)
49 C CALL FFT991(GV ,GWRK,TRIGS,IFAX,1,IMX,IMAX,LOT,1)
50 C
51 DO 100 J=1,JMAX
52 SINCLI=0.0
53 IF(SINCLT(J).GT.1.0D-6) THEN
54 SINCLI=1.0/(ER*SINCLT(J))
55 END IF
56 DO 100 K=1,KMAX
57 DO 100 I=1,IMAX
58 GU(I,J,K)=GU(I,J,K)*SINCLI
59 GV(I,J,K)=GV(I,J,K)*SINCLI
60 100 CONTINUE
61 C
62 C...CONVERSION TO ROT & DIV
63 L=0
64 DO 300 M=1,MEND1
65 NMAX=MIN(NEND1,JEND1+1-M)
66 DO 320 N=1,NMAX
67 AN =N+M-2
68 FNN1=-AN*(AN+1.0)*ERSQIV
69 *vdir loopcnt=200
70 DO 320 K=1,KMAX*2
71 QROT(K,1,L+N)=FNN1*QROT(K,1,L+N)
72 QDIV(K,1,L+N)=FNN1*QDIV(K,1,L+N)
73 320 CONTINUE
74 L=L+NMAX
75 300 CONTINUE
76 C
77 RETURN
78 END SUBROUTINE W2GUV
79