diff --git a/src/w3ft10.f b/src/w3ft10.f index ba362fbf..f8a3bc7c 100644 --- a/src/w3ft10.f +++ b/src/w3ft10.f @@ -1,60 +1,40 @@ C> @file -C -C> SUBPROGRAM: W3FT10 COMPUTES 2.5 X 2.5 S. HEMI. GRID-SCALER -C> AUTHOR: JONES,R.E. ORG: W323 DATE: 84-06-28 -C> -C> ABSTRACT: COMPUTES 2.5 X 2.5 S. HEMI. GRID OF 145 X 37 POINTS -C> FROM SPECTRAL COEFFICIENTS IN A RHOMBOIDAL 30 RESOLUTION -C> REPRESENTING A SCALER FIELD. -C> -C> PROGRAM HISTORY LOG: -C> 80-10-21 JOE SELA -C> 84-06-28 R.E.JONES CHANGE TO IBM VS FORTRAN -C> 89-01-25 R.E.JONES CHANGE TO MICROSOFT FORTRAN 4.10 -C> 90-06-12 R.E.JONES CHANGE TO SUN FORTRAN 1.3 -C> 91-03-30 R.E.JONES CONVERT TO SiliconGraphics FORTRAN -C> 93-03-29 R.E.JONES ADD SAVE STATEMENT -C> 93-07-22 R.E.JONES CHANGE DOUBLE PRECISION TO REAL FOR CRAY -C> -C> USAGE: CALL W3FT10(FLN,GN,PLN,EPS,FL,WORK,TRIGS) -C> -C> INPUT VARIABLES: -C> NAMES INTERFACE DESCRIPTION OF VARIABLES AND TYPES -C> ------ --------- ----------------------------------------------- -C> FLN ARG LIST 961 COMPLEX COEFF. -C> PLN ARG LIST 992 REAL SPACE FOR LEGENDRE POLYNOMIALS. -C> EPS ARG LIST 992 REAL SPACE FOR -C> COEFFS. USED IN COMPUTING PLN. -C> FL ARG LIST 31 COMPLEX SPACE FOR FOURIER COEFF. -C> WORK ARG LIST 144 REAL WORK SPACE FOR SUBR. W3FT12 -C> TRIGS ARG LIST 216 PRECOMPUTED TRIG FUNCS. USED -C> IN W3FT12, COMPUTED BY W3FA13 -C> -C> OUTPUT VARIABLES: -C> NAMES INTERFACE DESCRIPTION OF VARIABLES AND TYPES -C> ------ --------- ----------------------------------------------- -C> GN ARG LIST (145,37) GRID VALUES. -C> 5365 POINT GRID IS TYPE 30 OR 1E O.N. 84 +C> @brief Computes 2.5 x 2.5 s. hemi. grid-scaler. +C> @author Joe Sela @date 1980-10-21 + +C> Computes 2.5 x 2.5 s. hemi. grid of 145 x 37 points +C> from spectral coefficients in a rhomboidal 30 resolution +C> representing a scaler field. C> -C> SUBPROGRAMS CALLED: -C> NAMES LIBRARY -C> ------------------------------------------------------- -------- -C> AIMAG CMPLX REAL SYSTEM -C> W3FA12 W3FT12 W3LIB +C> ### Program History Log: +C> Date | Programmer | Comment +C> -----|------------|-------- +C> 1980-10-21 | Joe Sela | Initial. +C> 1984-06-28 | Ralph Jones | Change to ibm vs fortran. +C> 1989-01-25 | Ralph Jones | Change to microsoft fortran 4.10. +C> 1990-06-12 | Ralph Jones | Change to sun fortran 1.3. +C> 1991-03-30 | Ralph Jones | Convert to silicongraphics fortran. +C> 1993-03-29 | Ralph Jones | Add save statement. +C> 1993-07-22 | Ralph Jones | Change double precision to real for cray. C> -C> WARNING: THIS SUBROUTINE WAS OPTIMIZED TO RUN IN A SMALL AMOUNT OF -C> MEMORY, IT IS NOT OPTIMIZED FOR SPEED, 70 PERCENT OF THE TIME IS -C> USED BY SUBROUTINE W3FA12 COMPUTING THE LEGENDRE POLYNOMIALS. SINCE -C> THE LEGENDRE POLYNOMIALS ARE CONSTANT THEY NEED TO BE COMPUTED -C> ONLY ONCE IN A PROGRAM. BY MOVING W3FA12 TO THE MAIN PROGRAM AND -C> COMPUTING PLN AS A (32,31,37) ARRAY AND CHANGING THIS SUBROUTINE -C> TO USE PLN AS A THREE DIMENSION ARRAY YOU CAN CUT THE RUNNING TIME -C> 70 PERCENT. +C> @param[in] FLN 961 complex coeff. +C> @param[in] PLN 992 real space for legendre polynomials. +C> @param[in] EPS 992 real space for coeffs. used in computing pln. +C> @param[in] FL 31 complex space for fourier coeff. +C> @param[in] WORK 144 real work space for subr. w3ft12() +C> @param[in] TRIGS 216 precomputed trig funcs. used in w3ft12(), computed by w3fa13() +C> @param[out] GN (145,37) grid values. 5365 point grid is type 30 or 1e o.n. 84 C> -C> ATTRIBUTES: -C> LANGUAGE: CRAY CFT77 FORTRAN -C> MACHINE: CRAY Y-MP8/864, CRAY Y-MP EL2/128 +C> @note This subroutine was optimized to run in a small amount of +C> memory, it is not optimized for speed, 70 percent of the time is +C> used by subroutine w3fa12() computing the legendre polynomials. Since +C> the legendre polynomials are constant they need to be computed +C> only once in a program. By moving w3fa12() to the main program and +C> computing pln as a (32,31,37) array and changing this subroutine +C> to use pln as a three dimension array you can cut the running time +C> 70 percent. C> +C> @author Joe Sela @date 1980-10-21 SUBROUTINE W3FT10(FLN,GN,PLN,EPS,FL,WORK,TRIGS) C COMPLEX FL( 31 ) diff --git a/src/w3ft11.f b/src/w3ft11.f index c3551109..a171306f 100644 --- a/src/w3ft11.f +++ b/src/w3ft11.f @@ -1,63 +1,42 @@ C> @file -C -C> SUBPROGRAM: W3FT11 COMPUTES 2.5X2.5 S. HEMI. GRID VECTOR -C> AUTHOR: SELA,JOE ORG: W323 DATE: 80-11-20 -C> -C> ABSTRACT: COMPUTES 2.5 X 2.5 S. HEMI. GRID OF 145 X 37 POINTS -C> FROM SPECTRAL COEFFICIENTS IN A RHOMBOIDAL 30 RESOLUTION -C> REPRESENTING A VECTOR FIELD. -C> -C> PROGRAM HISTORY LOG: -C> 80-11-20 JOE SELA -C> 84-06-15 R.E.JONES CHANGE TO IBM VS FORTRAN -C> 89-01-25 R.E.JONES CHANGE TO MICROSOFT FORTRAN 4.10 -C> 90-06-12 R.E.JONES CHANGE TO SUN FORTRAN 1.3 -C> 91-03-30 R.E.JONES CONVERT TO SiliconGraphics FORTRAN -C> 93-03-29 R.E.JONES ADD SAVE STATEMENT -C> 93-07-22 R.E.JONES CHANGE DOUBLE PRECISION TO REAL FOR CRAY -C> -C> USAGE: CALL W3FT11(VLN,GN,PLN,EPS,FL,WORK,TRIGS,RCOS) -C> -C> INPUT VARIABLES: -C> NAMES INTERFACE DESCRIPTION OF VARIABLES AND TYPES -C> ------ --------- ----------------------------------------------- -C> VLN ARG LIST 992 COMPLEX COEFF. -C> PLN ARG LIST 992 REAL SPACE FOR LEGENDRE POLYNOMIALS. -C> EPS ARG LIST 992 REAL SPACE FOR -C> COEFFS. USED IN COMPUTING PLN. -C> FL ARG LIST 31 COMPLEX SPACE FOR FOURIER COEFF. -C> WORK ARG LIST 144 REAL WORK SPACE FOR SUBR. W3FT12 -C> TRIGS ARG LIST 216 PRECOMPUTED TRIG FUNCS. USED -C> IN W3FT12, COMPUTED BY W3FA13 -C> RCOS ARG LIST 37 RECIPROCAL COSINE LATITUDES OF -C> 2.5 X 2.5 GRID MUST BE COMPUTED BEFORE -C> FIRST CALL TO W3FT11 USING SUBR. W3FA13. -C> -C> OUTPUT VARIABLES: -C> NAMES INTERFACE DESCRIPTION OF VARIABLES AND TYPES -C> ------ --------- ----------------------------------------------- -C> GN ARG LIST (145,37) GRID VALUES. -C> 5365 POINT GRID IS TYPE 30 OR 1E HEX O.N. 84 +C> @brief Computes 2.5x2.5 s. hemi. grid vector. +C> @author Joe Sela @date 1980-11-20 + +C> Computes 2.5 x 2.5 s. hemi. grid of 145 x 37 points +C> from spectral coefficients in a rhomboidal 30 resolution +C> representing a vector field. C> -C> SUBPROGRAMS CALLED: -C> NAMES LIBRARY -C> ------------------------------------------------------- -------- -C> AIMAG CMPLX REAL SYSTEM -C> W3FA12 W3FT12 W3LIB +C> ### Program History Log: +C> Date | Programmer | Comment +C> -----|------------|-------- +C> 1980-11-20 | Joe Sela | Initial. +C> 1984-06-15 | Ralph Jones | Change to ibm vs fortran. +C> 1989-01-25 | Ralph Jones | Change to microsoft fortran 4.10. +C> 1990-06-12 | Ralph Jones | Change to sun fortran 1.3. +C> 1991-03-30 | Ralph Jones | Convert to silicongraphics fortran. +C> 1993-03-29 | Ralph Jones | Add save statement. +C> 1993-07-22 | Ralph Jones | Change double precision to real for cray. C> -C> WARNING: THIS SUBROUTINE WAS OPTIMIZED TO RUN IN A SMALL AMOUNT OF -C> MEMORY, IT IS NOT OPTIMIZED FOR SPEED, 70 PERCENT OF THE TIME IS -C> USED BY SUBROUTINE W3FA12 COMPUTING THE LEGENDRE POLYNOMIALS. SINCE -C> THE LEGENDRE POLYNOMIALS ARE CONSTANT THEY NEED TO BE COMPUTED -C> ONLY ONCE IN A PROGRAM. BY MOVING W3FA12 TO THE MAIN PROGRAM AND -C> COMPUTING PLN AS A (32,31,37) ARRAY AND CHANGING THIS SUBROUTINE -C> TO USE PLN AS A THREE DIMENSION ARRAY YOU CAN CUT THE RUNNING TIME -C> 70 PERCENT. +C> @param[in] VLN 992 complex coeff. +C> @param[in] PLN 992 real space for legendre polynomials. +C> @param[in] EPS 992 real space for coeffs. used in computing pln. +C> @param[in] FL 31 complex space for fourier coeff. +C> @param[in] WORK 144 real work space for subr. w3ft12() +C> @param[in] TRIGS 216 precomputed trig funcs. used in w3ft12(), computed by w3fa13() +C> @param[in] RCOS 37 reciprocal cosine latitudes of 2.5 x 2.5 grid must be +C> computed before first call to w3ft11 using subr. w3fa13() +C> @param[out] GN (145,37) grid values. 5365 point grid is type 30 or 1e hex o.n. 84 C> -C> ATTRIBUTES: -C> LANGUAGE: CRAY CFT77 FORTRAN -C> MACHINE: CRAY Y-MP8/864, CRAY Y-MP EL2/128 +C> @note This subroutine was optimized to run in a small amount of +C> memory, it is not optimized for speed, 70 percent of the time is +C> used by subroutine w3fa12() computing the legendre polynomials. Since +C> the legendre polynomials are constant they need to be computed +C> only once in a program. by moving w3fa12() to the main program and +C> computing pln as a (32,31,37) array and changing this subroutine +C> to use pln as a three dimension array you can cut the running time +C> 70 percent. C> +C> @author Joe Sela @date 1980-11-20 SUBROUTINE W3FT11(VLN,GN,PLN,EPS,FL,WORK,TRIGS,RCOS) C COMPLEX FL( 31 ) diff --git a/src/w3ft12.f b/src/w3ft12.f index 43eba248..0e570bb9 100644 --- a/src/w3ft12.f +++ b/src/w3ft12.f @@ -1,238 +1,225 @@ - SUBROUTINE W3FT12(COEF,WORK,GRID,TRIGS) 00010000 -C$$$ SUBPROGRAM DOCUMENTATION BLOCK 00020000 -C 00030000 -C SUBPROGRAM: W3FT12 FAST FOURIER FOR 2.5 DEGREE GRID 00040000 -C AUTHOR: SELA,JOE ORG: W323 DATE: 80-11-21 00050000 -C 00060000 -C ABSTRACT: FAST FOURIER TO COMPUTE 145 GRID VALUES AT DESIRED 00070000 -C LATITUDE FROM 31 COMPLEX FOURIER COEFFICIENTS. THIS SUBROUTINE 00080000 -C IS SPECIAL PURPOSE FOR CONVERTING COEFFICIENTS TO A 2.5 DEGREE 00090000 -C LAT,LON GRID. 00100000 -C 00110000 -C PROGRAM HISTORY LOG: 00120000 -C 80-11-21 JOE SELA 00130000 -C 84-06-21 R.E.JONES CHANGE TO IBM VS FORTRAN 00140000 -C 93-04-12 R.E.JONES CHANGE TO CRAY CFT77 FORTRAN 00150000 -C 00160000 -C USAGE: CALL W3FT12(COEF,WORK,GRID,TRIGS) 00170000 -C 00180000 -C INPUT VARIABLES: 00190000 -C NAMES INTERFACE DESCRIPTION OF VARIABLES AND TYPES 00200000 -C ------ --------- ----------------------------------------------- 00210000 -C COEF ARG LIST 31 COMPLEX FOURIER COEFFICIENTS. 00220000 -C TRIGS ARG LIST 216 TRIG FUNCTIONS ASSUMED PRECOMPUTED 00230000 -C BY W3FA13 BEFORE FIRST CALL TO W3FT12. 00240000 -C WORK ARG LIST 144 REAL WORK SPACE 00250000 -C 00260000 -C OUTPUT VARIABLES: 00270000 -C NAMES INTERFACE DESCRIPTION OF VARIABLES AND TYPES 00280000 -C ------ --------- ----------------------------------------------- 00290000 -C GRID ARG LIST 145 GRID VALUES, GRID(1)=GRID(145) 00300000 -C 00310000 -C ATTRIBUTES: 00320000 -C LANGUAGE: CRAY CFT77 FORTRAN 77 00330000 -C MACHINE: CRAY C916-128, Y-MP8/864, Y-MP EL92/256 00340002 -C 00350000 -C$$$ 00360000 -C 00370000 - REAL COEF( 62 ) 00380000 - REAL GRID(145) 00390000 - REAL TRIGS(216) 00400000 - REAL WORK(144) 00410000 -C 00411003 - SAVE 00412003 -C 00420000 - DATA SIN60/0.866025403784437/ 00430000 -C 00440000 - GRID(1) = COEF(1) 00450000 - GRID(2) = COEF(1) 00460000 - K = 147 00470000 - J = 143 00480000 - DO 100 I=3, 61 ,2 00490000 - TEMP = COEF(I)*TRIGS(K+1) - COEF(I+1)*TRIGS(K) 00500000 - GRID(I) = COEF(I) - TEMP 00510000 - GRID(J) = COEF(I) + TEMP 00520000 - TEMP = COEF(I)*TRIGS(K) + COEF(I+1)*TRIGS(K+1) 00530000 - GRID(I+1) = TEMP - COEF(I+1) 00540000 - GRID(J+1) = TEMP + COEF(I+1) 00550000 - K = K + 2 00560000 - J = J - 2 00570000 -100 CONTINUE 00580000 - DO 110 I= 63 , 84 00590000 - GRID(I) = 0.0 00600000 -110 CONTINUE 00610000 -C 00620000 - A0 = GRID(1) + GRID(73) 00630000 - A2 = GRID(1) - GRID(73) 00640000 - B0 = GRID(2) + GRID(74) 00650000 - B2 = GRID(2) - GRID(74) 00660000 - A1 = GRID(37) + GRID(109) 00670000 - A3 = GRID(37) - GRID(109) 00680000 - B1 = GRID(38) + GRID(110) 00690000 - B3 = GRID(38) - GRID(110) 00700000 - WORK(1) = A0 + A1 00710000 - WORK(5) = A0 - A1 00720000 - WORK(2) = B0 + B1 00730000 - WORK(6) = B0 - B1 00740000 - WORK(3) = A2 - B3 00750000 - WORK(7) = A2 + B3 00760000 - WORK(4) = B2 + A3 00770000 - WORK(8) = B2 - A3 00780000 - KB = 3 00790000 - KC = 5 00800000 - KD = 7 00810000 - J = 75 00820000 - K = 39 00830000 - L = 111 00840000 - M = 9 00850000 - DO 300 I=3,35,2 00860000 - A0 = GRID(I) + GRID(J) 00870000 - A2 = GRID(I) - GRID(J) 00880000 - B0 = GRID(I+1) + GRID(J+1) 00890000 - B2 = GRID(I+1) - GRID(J+1) 00900000 - A1 = GRID(K) + GRID(L) 00910000 - A3 = GRID(K) - GRID(L) 00920000 - B1 = GRID(K+1) + GRID(L+1) 00930000 - B3 = GRID(K+1) - GRID(L+1) 00940000 - WORK(M ) = A0 + A1 00950000 - WORK(M+4) = A0 - A1 00960000 - WORK(M+1) = B0 + B1 00970000 - WORK(M+5) = B0 - B1 00980000 - WORK(M+2) = A2 - B3 00990000 - WORK(M+6) = A2 + B3 01000000 - WORK(M+3) = B2 + A3 01010000 - WORK(M+7) = B2 - A3 01020000 - TEMP = WORK(M+2)*TRIGS(KB) - WORK(M+3)*TRIGS(KB+1) 01030000 - WORK(M+3) = WORK(M+2)*TRIGS(KB+1) + WORK(M+3)*TRIGS(KB) 01040000 - WORK(M+2) = TEMP 01050000 - TEMP = WORK(M+4)*TRIGS(KC) - WORK(M+5)*TRIGS(KC+1) 01060000 - WORK(M+5) = WORK(M+4)*TRIGS(KC+1) + WORK(M+5)*TRIGS(KC) 01070000 - WORK(M+4) = TEMP 01080000 - TEMP = WORK(M+6)*TRIGS(KD) - WORK(M+7)*TRIGS(KD+1) 01090000 - WORK(M+7) = WORK(M+6)*TRIGS(KD+1) + WORK(M+7)*TRIGS(KD) 01100000 - WORK(M+6) = TEMP 01110000 - J = J + 2 01120000 - K = K + 2 01130000 - L = L + 2 01140000 - KB = KB + 2 01150000 - KC = KC + 4 01160000 - KD = KD + 6 01170000 - M = M + 8 01180000 -300 CONTINUE 01190000 -C 01200000 - I = 1 01210000 - J = 1 01220000 - K = 73 01230000 - DO 440 L=1,4 01240000 - GRID(I) = WORK(J) + WORK(K) 01250000 - GRID(I+8) = WORK(J) - WORK(K) 01260000 - GRID(I+1) = WORK(J+1) + WORK(K+1) 01270000 - GRID(I+9) = WORK(J+1) - WORK(K+1) 01280000 - I = I + 2 01290000 - J = J + 2 01300000 - K = K + 2 01310000 -440 CONTINUE 01320000 - DO 500 KB=9,65,8 01330000 - I = I + 8 01340000 - DO 460 L=1,4 01350000 - GRID(I) = WORK(J) + WORK(K) 01360000 - GRID(I+8) = WORK(J) - WORK(K) 01370000 - GRID(I+1) = WORK(J+1) + WORK(K+1) 01380000 - GRID(I+9) = WORK(J+1) - WORK(K+1) 01390000 - TEMP = GRID(I+8)*TRIGS(KB) - GRID(I+9)*TRIGS(KB+1) 01400000 - GRID(I+9) = GRID(I+8)*TRIGS(KB+1) + GRID(I+9)*TRIGS(KB) 01410000 - GRID(I+8) = TEMP 01420000 - I = I + 2 01430000 - J = J + 2 01440000 - K = K + 2 01450000 -460 CONTINUE 01460000 -500 CONTINUE 01470000 -C 01480000 - I = 1 01490000 - L = 1 01500000 - KC = 1 01510000 - J = 49 01520000 - K = 97 01530000 - M = 17 01540000 - N = 33 01550000 - DO 660 LL=1,8 01560000 - A1 = GRID(J) + GRID(K) 01570000 - A3 = SIN60*(GRID(J)-GRID(K)) 01580000 - B1 = GRID(J+1) + GRID(K+1) 01590000 - B3 = SIN60*(GRID(J+1)-GRID(K+1)) 01600000 - WORK(L) = GRID(I) + A1 01610000 - A2 = GRID(I) - 0.5*A1 01620000 - WORK(L+1) = GRID(I+1) + B1 01630000 - B2 = GRID(I+1) - 0.5*B1 01640000 - WORK(N) = A2 + B3 01650000 - WORK(M) = A2 - B3 01660000 - WORK(M+1) = B2 + A3 01670000 - WORK(N+1) = B2 - A3 01680000 - I = I + 2 01690000 - J = J + 2 01700000 - K = K + 2 01710000 - L = L + 2 01720000 - M = M + 2 01730000 - N = N + 2 01740000 -660 CONTINUE 01750000 - DO 700 KB=17,33,16 01760000 - L = L + 32 01770000 - M = M + 32 01780000 - N = N + 32 01790000 - KC = KC + 32 01800000 - DO 680 LL=1,8 01810000 - A1 = GRID(J) + GRID(K) 01820000 - A3 = SIN60*(GRID(J)-GRID(K)) 01830000 - B1 = GRID(J+1) + GRID(K+1) 01840000 - B3 = SIN60*(GRID(J+1)-GRID(K+1)) 01850000 - WORK(L) = GRID(I) + A1 01860000 - A2 = GRID(I) - 0.5*A1 01870000 - WORK(L+1) = GRID(I+1) + B1 01880000 - B2 = GRID(I+1) - 0.5*B1 01890000 - WORK(N) = A2 + B3 01900000 - WORK(M) = A2 - B3 01910000 - WORK(M+1) = B2 + A3 01920000 - WORK(N+1) = B2 - A3 01930000 - TEMP = WORK(M)*TRIGS(KB) - WORK(M+1)*TRIGS(KB+1) 01940000 - WORK(M+1) = WORK(M)*TRIGS(KB+1) + WORK(M+1)*TRIGS(KB) 01950000 - WORK(M) = TEMP 01960000 - TEMP = WORK(N)*TRIGS(KC) - WORK(N+1)*TRIGS(KC+1) 01970000 - WORK(N+1) = WORK(N)*TRIGS(KC+1) + WORK(N+1)*TRIGS(KC) 01980000 - WORK(N) = TEMP 01990000 - I = I + 2 02000000 - J = J + 2 02010000 - K = K + 2 02020000 - L = L + 2 02030000 - M = M + 2 02040000 - N = N + 2 02050000 -680 CONTINUE 02060000 -700 CONTINUE 02070000 -C 02080000 - J = 49 02090000 - K = 97 02100000 - L = 144 02110000 - M = 96 02120000 - N = 48 02130000 - DO 900 I=1,47,2 02140000 - A1 = WORK(J) + WORK(K) 02150000 - A3 = SIN60 * (WORK(J)-WORK(K)) 02160000 - B3 = SIN60 * (WORK(J+1)-WORK(K+1)) 02170000 - B1 = WORK(J+1) + WORK(K+1) 02180000 - GRID(L+1) = WORK(I) + A1 02190000 - A2 = WORK(I) - 0.5*A1 02200000 - B2 = WORK(I+1) - 0.5*B1 02210000 - GRID(L) = WORK(I+1) + B1 02220000 - GRID(N+1) = A2 + B3 02230000 - GRID(M+1) = A2 - B3 02240000 - GRID(M) = B2 + A3 02250000 - GRID(N) = B2 - A3 02260000 - J = J + 2 02270000 - K = K + 2 02280000 - L = L - 2 02290000 - M = M - 2 02300000 - N = N - 2 02310000 -900 CONTINUE 02320000 - GRID(1) = GRID(145) 02330000 -C 02340000 - RETURN 02350000 - END 02360000 +C> @file +C> @brief Fast fourier for 2.5 degree grid. +C> @author Joe Sela @date 1980-11-21 + +C> Fast fourier to compute 145 grid values at desired +C> latitude from 31 complex fourier coefficients. This subroutine +C> is special purpose for converting coefficients to a 2.5 degree +C> lat,lon grid. +C> +C> ### Program History Log: +C> Date | Programmer | Comment +C> -----|------------|-------- +C> 1980-11-21 | Joe Sela | Initial. +C> 1984-06-21 | Ralph Jones | Change to ibm vs fortran. +C> 1993-04-12 | Ralph Jones | Change to cray cft77 fortran. +C> +C> @param[in] COEF 31 complex fourier coefficients. +C> @param[in] TRIGS 216 trig functions assumed precomputed by w3fa13() before +C> first call to w3ft12(). +C> @param[in] WORK 144 real work space +C> @param[out] GRID 145 grid values, grid(1)=grid(145) +C> +C> @author Joe Sela @date 1980-11-21 + SUBROUTINE W3FT12(COEF,WORK,GRID,TRIGS) + REAL COEF( 62 ) + REAL GRID(145) + REAL TRIGS(216) + REAL WORK(144) +C + SAVE +C + DATA SIN60/0.866025403784437/ +C + GRID(1) = COEF(1) + GRID(2) = COEF(1) + K = 147 + J = 143 + DO 100 I=3, 61 ,2 + TEMP = COEF(I)*TRIGS(K+1) - COEF(I+1)*TRIGS(K) + GRID(I) = COEF(I) - TEMP + GRID(J) = COEF(I) + TEMP + TEMP = COEF(I)*TRIGS(K) + COEF(I+1)*TRIGS(K+1) + GRID(I+1) = TEMP - COEF(I+1) + GRID(J+1) = TEMP + COEF(I+1) + K = K + 2 + J = J - 2 +100 CONTINUE + DO 110 I= 63 , 84 + GRID(I) = 0.0 +110 CONTINUE +C + A0 = GRID(1) + GRID(73) + A2 = GRID(1) - GRID(73) + B0 = GRID(2) + GRID(74) + B2 = GRID(2) - GRID(74) + A1 = GRID(37) + GRID(109) + A3 = GRID(37) - GRID(109) + B1 = GRID(38) + GRID(110) + B3 = GRID(38) - GRID(110) + WORK(1) = A0 + A1 + WORK(5) = A0 - A1 + WORK(2) = B0 + B1 + WORK(6) = B0 - B1 + WORK(3) = A2 - B3 + WORK(7) = A2 + B3 + WORK(4) = B2 + A3 + WORK(8) = B2 - A3 + KB = 3 + KC = 5 + KD = 7 + J = 75 + K = 39 + L = 111 + M = 9 + DO 300 I=3,35,2 + A0 = GRID(I) + GRID(J) + A2 = GRID(I) - GRID(J) + B0 = GRID(I+1) + GRID(J+1) + B2 = GRID(I+1) - GRID(J+1) + A1 = GRID(K) + GRID(L) + A3 = GRID(K) - GRID(L) + B1 = GRID(K+1) + GRID(L+1) + B3 = GRID(K+1) - GRID(L+1) + WORK(M ) = A0 + A1 + WORK(M+4) = A0 - A1 + WORK(M+1) = B0 + B1 + WORK(M+5) = B0 - B1 + WORK(M+2) = A2 - B3 + WORK(M+6) = A2 + B3 + WORK(M+3) = B2 + A3 + WORK(M+7) = B2 - A3 + TEMP = WORK(M+2)*TRIGS(KB) - WORK(M+3)*TRIGS(KB+1) + WORK(M+3) = WORK(M+2)*TRIGS(KB+1) + WORK(M+3)*TRIGS(KB) + WORK(M+2) = TEMP + TEMP = WORK(M+4)*TRIGS(KC) - WORK(M+5)*TRIGS(KC+1) + WORK(M+5) = WORK(M+4)*TRIGS(KC+1) + WORK(M+5)*TRIGS(KC) + WORK(M+4) = TEMP + TEMP = WORK(M+6)*TRIGS(KD) - WORK(M+7)*TRIGS(KD+1) + WORK(M+7) = WORK(M+6)*TRIGS(KD+1) + WORK(M+7)*TRIGS(KD) + WORK(M+6) = TEMP + J = J + 2 + K = K + 2 + L = L + 2 + KB = KB + 2 + KC = KC + 4 + KD = KD + 6 + M = M + 8 +300 CONTINUE +C + I = 1 + J = 1 + K = 73 + DO 440 L=1,4 + GRID(I) = WORK(J) + WORK(K) + GRID(I+8) = WORK(J) - WORK(K) + GRID(I+1) = WORK(J+1) + WORK(K+1) + GRID(I+9) = WORK(J+1) - WORK(K+1) + I = I + 2 + J = J + 2 + K = K + 2 +440 CONTINUE + DO 500 KB=9,65,8 + I = I + 8 + DO 460 L=1,4 + GRID(I) = WORK(J) + WORK(K) + GRID(I+8) = WORK(J) - WORK(K) + GRID(I+1) = WORK(J+1) + WORK(K+1) + GRID(I+9) = WORK(J+1) - WORK(K+1) + TEMP = GRID(I+8)*TRIGS(KB) - GRID(I+9)*TRIGS(KB+1) + GRID(I+9) = GRID(I+8)*TRIGS(KB+1) + GRID(I+9)*TRIGS(KB) + GRID(I+8) = TEMP + I = I + 2 + J = J + 2 + K = K + 2 +460 CONTINUE +500 CONTINUE +C + I = 1 + L = 1 + KC = 1 + J = 49 + K = 97 + M = 17 + N = 33 + DO 660 LL=1,8 + A1 = GRID(J) + GRID(K) + A3 = SIN60*(GRID(J)-GRID(K)) + B1 = GRID(J+1) + GRID(K+1) + B3 = SIN60*(GRID(J+1)-GRID(K+1)) + WORK(L) = GRID(I) + A1 + A2 = GRID(I) - 0.5*A1 + WORK(L+1) = GRID(I+1) + B1 + B2 = GRID(I+1) - 0.5*B1 + WORK(N) = A2 + B3 + WORK(M) = A2 - B3 + WORK(M+1) = B2 + A3 + WORK(N+1) = B2 - A3 + I = I + 2 + J = J + 2 + K = K + 2 + L = L + 2 + M = M + 2 + N = N + 2 +660 CONTINUE + DO 700 KB=17,33,16 + L = L + 32 + M = M + 32 + N = N + 32 + KC = KC + 32 + DO 680 LL=1,8 + A1 = GRID(J) + GRID(K) + A3 = SIN60*(GRID(J)-GRID(K)) + B1 = GRID(J+1) + GRID(K+1) + B3 = SIN60*(GRID(J+1)-GRID(K+1)) + WORK(L) = GRID(I) + A1 + A2 = GRID(I) - 0.5*A1 + WORK(L+1) = GRID(I+1) + B1 + B2 = GRID(I+1) - 0.5*B1 + WORK(N) = A2 + B3 + WORK(M) = A2 - B3 + WORK(M+1) = B2 + A3 + WORK(N+1) = B2 - A3 + TEMP = WORK(M)*TRIGS(KB) - WORK(M+1)*TRIGS(KB+1) + WORK(M+1) = WORK(M)*TRIGS(KB+1) + WORK(M+1)*TRIGS(KB) + WORK(M) = TEMP + TEMP = WORK(N)*TRIGS(KC) - WORK(N+1)*TRIGS(KC+1) + WORK(N+1) = WORK(N)*TRIGS(KC+1) + WORK(N+1)*TRIGS(KC) + WORK(N) = TEMP + I = I + 2 + J = J + 2 + K = K + 2 + L = L + 2 + M = M + 2 + N = N + 2 +680 CONTINUE +700 CONTINUE +C + J = 49 + K = 97 + L = 144 + M = 96 + N = 48 + DO 900 I=1,47,2 + A1 = WORK(J) + WORK(K) + A3 = SIN60 * (WORK(J)-WORK(K)) + B3 = SIN60 * (WORK(J+1)-WORK(K+1)) + B1 = WORK(J+1) + WORK(K+1) + GRID(L+1) = WORK(I) + A1 + A2 = WORK(I) - 0.5*A1 + B2 = WORK(I+1) - 0.5*B1 + GRID(L) = WORK(I+1) + B1 + GRID(N+1) = A2 + B3 + GRID(M+1) = A2 - B3 + GRID(M) = B2 + A3 + GRID(N) = B2 - A3 + J = J + 2 + K = K + 2 + L = L - 2 + M = M - 2 + N = N - 2 +900 CONTINUE + GRID(1) = GRID(145) +C + RETURN + END diff --git a/src/w3ft16.f b/src/w3ft16.f index cffafe21..08828fd9 100644 --- a/src/w3ft16.f +++ b/src/w3ft16.f @@ -1,49 +1,30 @@ C> @file -C -C> SUBROUTINE: W3FT16 CONVERT (95,91) GRID TO (3447) GRID -C> AUTHOR: JONES,R.E. ORG: W342 DATE: 94-05-03 -C> -C> ABSTRACT: CONVERT A NORTHERN HEMISPHERE 1.0 DEGREE LAT.,LON. 95 BY -C> 91 GRID TO A WAFS 1.25 DEGREE THINNED 3447 POINT GRID. -C> -C> PROGRAM HISTORY LOG: -C> 94-05-03 R.E.JONES -C> -C> USAGE: CALL W3FT16(ALOLA,BTHIN,INTERP) -C> -C> INPUT ARGUMENTS: ALOLA - 95 * 91 GRID 1.0 DEG. LAT,LON GRID -C> NORTHERN HEMISPHERE 8645 POINT GRID. -C> INTERP - 1 LINEAR INTERPOLATION , NE.1 BIQUADRATIC -C> -C> INPUT FILES: NONE -C> -C> OUTPUT ARGUMENTS: BTHIN - 3447 POINT THINNED GRID OF N. HEMISPERE -C> 3447 GRID IS FOR GRIB GRIDS 37-40. -C> -C> OUTPUT FILES: ERROR MESSAGE TO FORTRAN OUTPUT FILE -C> -C> WARNINGS: -C> -C> 1. W1 AND W2 ARE USED TO STORE SETS OF CONSTANTS WHICH ARE -C> REUSABLE FOR REPEATED CALLS TO THE SUBROUTINE. 10 OTHER ARRAYS -C> ARE SAVED AND REUSED ON THE NEXT CALL. -C> -C> RETURN CONDITIONS: NORMAL SUBROUTINE EXIT +C> @brief Convert (95,91) grid to (3447) grid +C> @author Ralph Jones @date 1994-05-03 + +C> Convert a northern hemisphere 1.0 degree lat.,lon. 95 by +C> 91 grid to a wafs 1.25 degree thinned 3447 point grid. C> -C> SUBPROGRAMS CALLED: -C> UNIQUE : NONE +C> ### Program History Log: +C> Date | Programmer | Comment +C> -----|------------|-------- +C> 1994-05-03 | Ralph Jones | Initial. C> -C> LIBRARY: +C> @param[in] ALOLA 95 * 91 grid 1.0 deg. lat,lon grid northern hemisphere 8645 point grid. +C> @param[in] INTERP 1 linear interpolation , ne.1 biquadratic +C> @param[out] BTHIN 3447 point thinned grid of n. hemispere 3447 grid is for grib grids 37-40. C> -C> ATTRIBUTES: -C> LANGUAGE: CRAY CFT77 FORTRAN -C> MACHINE: CRAY C916-128, cRAY Y-MP8/864, CRAY Y-MP EL2/256 +C> @note +C> - W1 and w2 are used to store sets of constants which are +C> reusable for repeated calls to the subroutine. 10 other arrays +C> are saved and reused on the next call. C> +C> @author Ralph Jones @date 1994-05-03 SUBROUTINE W3FT16(ALOLA,BTHIN,INTERP) C PARAMETER (NPTS=3447) C - REAL SEP(73) + REAL SEP(73) REAL ALOLA(95,91), BTHIN(NPTS), ERAS(NPTS,4) REAL W1(NPTS), W2(NPTS) REAL XDELI(NPTS), XDELJ(NPTS) diff --git a/src/w3ft17.f b/src/w3ft17.f index 0570afe9..a401c95e 100644 --- a/src/w3ft17.f +++ b/src/w3ft17.f @@ -1,49 +1,30 @@ C> @file -C -C> SUBROUTINE: W3FT17 CONVERT (95,91) GRID TO (3447) GRID -C> AUTHOR: JONES,R.E. ORG: W342 DATE: 94-05-03 -C> -C> ABSTRACT: CONVERT A SOUTHERN HEMISPHERE 1.0 DEGREE LAT.,LON. 95 BY -C> 91 GRID TO A WAFS 1.25 DEGREE THINNED 3447 POINT GRID. -C> -C> PROGRAM HISTORY LOG: -C> 94-05-03 R.E.JONES -C> -C> USAGE: CALL W3FT17(ALOLA,BTHIN,INTERP) -C> -C> INPUT ARGUMENTS: ALOLA - 95 * 91 GRID 1.0 DEG. LAT,LON GRID -C> SOUTHERN HEMISPHERE 8645 POINT GRID. -C> INTERP - 1 LINEAR INTERPOLATION , NE.1 BIQUADRATIC -C> -C> INPUT FILES: NONE -C> -C> OUTPUT ARGUMENTS: BTHIN - 3447 POINT THINNED GRID OF S. HEMISPERE -C> 3447 GRID IS FOR GRIB GRIDS 41-44. -C> -C> OUTPUT FILES: ERROR MESSAGE TO FORTRAN OUTPUT FILE -C> -C> WARNINGS: -C> -C> 1. W1 AND W2 ARE USED TO STORE SETS OF CONSTANTS WHICH ARE -C> REUSABLE FOR REPEATED CALLS TO THE SUBROUTINE. 10 OTHER ARRAYS -C> ARE SAVED AND REUSED ON THE NEXT CALL. -C> -C> RETURN CONDITIONS: NORMAL SUBROUTINE EXIT +C> @brief Convert (95,91) grid to (3447) grid +C> @author Ralph Jones @date 1994-05-03 + +C> Convert a southern hemisphere 1.0 degree lat.,lon. 95 by +C> 91 grid to a wafs 1.25 degree thinned 3447 point grid. C> -C> SUBPROGRAMS CALLED: -C> UNIQUE : NONE +C> ### Program History Log: +C> Date | Programmer | Comment +C> -----|------------|-------- +C> 1994-05-03 | Ralph Jones | Initial. C> -C> LIBRARY: +C> @param[in] ALOLA 95 * 91 grid 1.0 deg. lat,lon grid southern hemisphere 8645 point grid. +C> @param[in] INTERP 1 linear interpolation , ne.1 biquadratic +C> @param[out] BTHIN 3447 point thinned grid of s. hemispere 3447 grid is for grib grids 41-44. C> -C> ATTRIBUTES: -C> LANGUAGE: CRAY CFT77 FORTRAN -C> MACHINE: CRAY C916-128, cRAY Y-MP8/864, CRAY Y-MP EL2/256 +C> @note +C> - w1 and w2 are used to store sets of constants which are +C> reusable for repeated calls to the subroutine. 10 other arrays +C> are saved and reused on the next call. C> +C> @author Ralph Jones @date 1994-05-03 SUBROUTINE W3FT17(ALOLA,BTHIN,INTERP) C PARAMETER (NPTS=3447) C - REAL SEP(73) + REAL SEP(73) REAL ALOLA(95,91), BTHIN(NPTS), ERAS(NPTS,4) REAL W1(NPTS), W2(NPTS) REAL XDELI(NPTS), XDELJ(NPTS)