PageRenderTime 55ms CodeModel.GetById 26ms RepoModel.GetById 0ms app.codeStats 0ms

/wrfv2_fire/dyn_em/module_init_utilities.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 95 lines | 76 code | 16 blank | 3 comment | 12 complexity | e1fdcd1bd61be6637c41fc8083e39474 MD5 | raw file
Possible License(s): AGPL-1.0
  1. MODULE module_init_utilities
  2. CONTAINS
  3. real function interp_0( v_in, &
  4. z_in, z_out, nz_in )
  5. implicit none
  6. integer nz_in, nz_out
  7. real v_in(nz_in), z_in(nz_in)
  8. real z_out
  9. integer kp, k, im, ip
  10. logical interp, increasing_z
  11. real height, w1, w2
  12. logical debug
  13. parameter ( debug = .false. )
  14. ! does vertical coordinate increase or decrease with increasing k?
  15. ! set offset appropriately
  16. height = z_out
  17. if(debug) write(6,*) ' height in interp_0 ',height
  18. if (z_in(nz_in) .gt. z_in(1)) then
  19. if(debug) write(6,*) ' monotonic increase in z in interp_0 '
  20. IF (height > z_in(nz_in)) then
  21. if(debug) write(6,*) ' point 1 in interp_0 '
  22. w2 = (z_in(nz_in)-height)/(z_in(nz_in)-z_in(nz_in-1))
  23. w1 = 1.-w2
  24. interp_0 = w1*v_in(nz_in) + w2*v_in(nz_in-1)
  25. ELSE IF (height < z_in(1)) then
  26. if(debug) write(6,*) ' point 2 in interp_0 '
  27. w2 = (z_in(2)-height)/(z_in(2)-z_in(1))
  28. w1 = 1.-w2
  29. interp_0 = w1*v_in(2) + w2*v_in(1)
  30. ELSE
  31. if(debug) write(6,*) ' point 3 in interp_0 '
  32. interp = .false.
  33. kp = nz_in
  34. DO WHILE ( (interp .eqv. .false.) .and. (kp .ge. 2) )
  35. IF( ((z_in(kp) .ge. height) .and. &
  36. (z_in(kp-1) .le. height)) ) THEN
  37. w2 = (height-z_in(kp))/(z_in(kp-1)-z_in(kp))
  38. w1 = 1.-w2
  39. interp_0 = w1*v_in(kp) + w2*v_in(kp-1)
  40. if(debug) write(6,*) ' interp data, kp, w1, w2 ',kp, w1, w2
  41. if(debug) write(6,*) ' interp data, v_in(kp), v_in(kp-1), interp_0 ', &
  42. v_in(kp), v_in(kp-1), interp_0
  43. interp = .true.
  44. END IF
  45. kp = kp-1
  46. ENDDO
  47. ENDIF
  48. else
  49. if(debug) write(6,*) ' monotonic decrease in z in interp_0 '
  50. IF (height < z_in(nz_in)) then
  51. if(debug) write(6,*) ' point 1 in interp_0 '
  52. w2 = (z_in(nz_in)-height)/(z_in(nz_in)-z_in(nz_in-1))
  53. w1 = 1.-w2
  54. interp_0 = w1*v_in(nz_in) + w2*v_in(nz_in-1)
  55. ELSE IF (height > z_in(1)) then
  56. if(debug) write(6,*) ' point 2 in interp_0 '
  57. w2 = (z_in(2)-height)/(z_in(2)-z_in(1))
  58. w1 = 1.-w2
  59. interp_0 = w1*v_in(2) + w2*v_in(1)
  60. ELSE
  61. if(debug) write(6,*) ' point 3 in interp_0 '
  62. interp = .false.
  63. kp = nz_in
  64. height = z_out
  65. DO WHILE ( (interp .eqv. .false.) .and. (kp .ge. 2) )
  66. IF( ((z_in(kp) .le. height) .and. &
  67. (z_in(kp-1) .ge. height)) ) THEN
  68. w2 = (height-z_in(kp))/(z_in(kp-1)-z_in(kp))
  69. w1 = 1.-w2
  70. interp_0 = w1*v_in(kp) + w2*v_in(kp-1)
  71. interp = .true.
  72. END IF
  73. kp = kp-1
  74. ENDDO
  75. ENDIF
  76. end if
  77. return
  78. END FUNCTION interp_0
  79. END MODULE module_init_utilities