Merge remote-tracking branch 'origin/release-v4.6.1'
[WRF.git] / var / convertor / kma_wave2grid / RFTF9M.inc
blob9689c8a43ac89a5e9598cbc83e614a9873c16539
1 C***********************************************************************
2       SUBROUTINE RFTF9M (N,INC,LOT, NA,C, WA,IFAC, CH)
3       DIMENSION       C(INC,N)   ,CH(INC,N)  ,WA(N)    ,IFAC(*)
4           NF = IFAC(2)
5           NA = 1
6           L2 = N
7           IW = N
8       DO 111 K1=1,NF
9           KH = NF-K1
10           IP = IFAC(KH+3)
11           L1 = L2/IP
12           IDO = N/L2
13           IDL1 = IDO*L1
14           IW = IW-(IP-1)*IDO
15           NA = 1-NA
16        IF (IP .EQ. 4) THEN
17            IX2 = IW +IDO
18            IX3 = IX2+IDO
19          IF (NA .EQ. 0) THEN
20            CALL RADF4M (INC,LOT,IDO,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
21          ELSE
22            CALL RADF4M (INC,LOT,IDO,L1,CH,C,WA(IW),WA(IX2),WA(IX3))
23          ENDIF
24        ELSE IF (IP .EQ. 2) THEN
25          IF (NA .EQ. 0) THEN
26            CALL RADF2M (INC,LOT,IDO,L1,C,CH,WA(IW))
27          ELSE
28            CALL RADF2M (INC,LOT,IDO,L1,CH,C,WA(IW))
29          ENDIF
30        ELSE IF (IP .EQ. 3) THEN
31            IX2 = IW +IDO
32          IF (NA .EQ. 0) THEN
33            CALL RADF3M (INC,LOT,IDO,L1,C,CH,WA(IW),WA(IX2))
34          ELSE
35            CALL RADF3M (INC,LOT,IDO,L1,CH,C,WA(IW),WA(IX2))
36          ENDIF
37        ELSE IF (IP .EQ. 5) THEN
38            IX2 = IW +IDO
39            IX3 = IX2+IDO
40            IX4 = IX3+IDO
41          IF (NA .EQ. 0) THEN
42            CALL RADF5M (INC,LOT,IDO,L1,C,CH
43      *                 ,WA(IW),WA(IX2),WA(IX3),WA(IX4))
44          ELSE
45            CALL RADF5M (INC,LOT,IDO,L1,CH,C
46      *                 ,WA(IW),WA(IX2),WA(IX3),WA(IX4))
47          ENDIF
48        ELSE
49          IF (IDO .EQ. 1) NA = 1-NA
50          IF (NA .EQ. 0) THEN
51            CALL RADFGM (INC,LOT,IDO,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
52            NA = 1
53          ELSE
54            CALL RADFGM (INC,LOT,IDO,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))
55            NA = 0
56          ENDIF
57        ENDIF
58            L2 = L1
59   111 CONTINUE
60       RETURN
61       END SUBROUTINE RFTF9M