PageRenderTime 50ms CodeModel.GetById 19ms RepoModel.GetById 0ms app.codeStats 0ms

/wrfv2_fire/external/fftpack/fftpack5/cfft2b.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 59 lines | 32 code | 1 blank | 26 comment | 0 complexity | 1037883a48ae2cea27f7610256378a1c MD5 | raw file
Possible License(s): AGPL-1.0
  1. !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  2. !
  3. ! FFTPACK 5.0
  4. !
  5. ! Authors: Paul N. Swarztrauber and Richard A. Valent
  6. !
  7. ! $Id: cfft2b.f,v 1.2 2004/06/15 21:08:32 rodney Exp $
  8. !
  9. !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  10. SUBROUTINE CFFT2B (LDIM, L, M, C, WSAVE, LENSAV, &
  11. & WORK, LENWRK, IER)
  12. INTEGER L, M, LDIM, LENSAV, LENWRK, IER
  13. COMPLEX C(LDIM,M)
  14. REAL WSAVE(LENSAV), WORK(LENWRK)
  15. !
  16. ! Initialize error return
  17. !
  18. IER = 0
  19. !
  20. IF (L .GT. LDIM) THEN
  21. IER = 5
  22. CALL XERFFT ('CFFT2B', -2)
  23. GO TO 100
  24. ELSEIF (LENSAV .LT. 2*L + INT(LOG(REAL(L))) + &
  25. & 2*M + INT(LOG(REAL(M))) +8) THEN
  26. IER = 2
  27. CALL XERFFT ('CFFT2B', 6)
  28. GO TO 100
  29. ELSEIF (LENWRK .LT. 2*L*M) THEN
  30. IER = 3
  31. CALL XERFFT ('CFFT2B', 8)
  32. GO TO 100
  33. ENDIF
  34. !
  35. ! Transform X lines of C array
  36. IW = 2*L+INT(LOG(REAL(L))*LOG(2.)) + 3
  37. CALL CFFTMB(L, 1, M, LDIM, C, (L-1) + LDIM*(M-1) +1, &
  38. & WSAVE(IW), 2*M + INT(LOG(REAL(M))) + 4, &
  39. & WORK, 2*L*M, IER1)
  40. IF (IER1 .NE. 0) THEN
  41. IER = 20
  42. CALL XERFFT ('CFFT2B',-5)
  43. GO TO 100
  44. ENDIF
  45. !
  46. ! Transform Y lines of C array
  47. IW = 1
  48. CALL CFFTMB (M, LDIM, L, 1, C, (M-1)*LDIM + L, &
  49. & WSAVE(IW), 2*L + INT(LOG(REAL(L))) + 4, &
  50. & WORK, 2*M*L, IER1)
  51. IF (IER1 .NE. 0) THEN
  52. IER = 20
  53. CALL XERFFT ('CFFT2B',-5)
  54. ENDIF
  55. !
  56. 100 CONTINUE
  57. RETURN
  58. END