| [2759] | 1 | MODULE module_init_utilities |
|---|
| 2 | |
|---|
| 3 | CONTAINS |
|---|
| 4 | |
|---|
| 5 | real function interp_0( v_in, & |
|---|
| 6 | z_in, z_out, nz_in ) |
|---|
| 7 | implicit none |
|---|
| 8 | integer nz_in, nz_out |
|---|
| 9 | real v_in(nz_in), z_in(nz_in) |
|---|
| 10 | real z_out |
|---|
| 11 | |
|---|
| 12 | integer kp, k, im, ip |
|---|
| 13 | logical interp, increasing_z |
|---|
| 14 | real height, w1, w2 |
|---|
| 15 | logical debug |
|---|
| 16 | parameter ( debug = .false. ) |
|---|
| 17 | |
|---|
| 18 | ! does vertical coordinate increase or decrease with increasing k? |
|---|
| 19 | ! set offset appropriately |
|---|
| 20 | |
|---|
| 21 | height = z_out |
|---|
| 22 | |
|---|
| 23 | if(debug) write(6,*) ' height in interp_0 ',height |
|---|
| 24 | |
|---|
| 25 | if (z_in(nz_in) .gt. z_in(1)) then |
|---|
| 26 | |
|---|
| 27 | if(debug) write(6,*) ' monotonic increase in z in interp_0 ' |
|---|
| 28 | IF (height > z_in(nz_in)) then |
|---|
| 29 | if(debug) write(6,*) ' point 1 in interp_0 ' |
|---|
| 30 | w2 = (z_in(nz_in)-height)/(z_in(nz_in)-z_in(nz_in-1)) |
|---|
| 31 | w1 = 1.-w2 |
|---|
| 32 | interp_0 = w1*v_in(nz_in) + w2*v_in(nz_in-1) |
|---|
| 33 | ELSE IF (height < z_in(1)) then |
|---|
| 34 | if(debug) write(6,*) ' point 2 in interp_0 ' |
|---|
| 35 | w2 = (z_in(2)-height)/(z_in(2)-z_in(1)) |
|---|
| 36 | w1 = 1.-w2 |
|---|
| 37 | interp_0 = w1*v_in(2) + w2*v_in(1) |
|---|
| 38 | ELSE |
|---|
| 39 | if(debug) write(6,*) ' point 3 in interp_0 ' |
|---|
| 40 | interp = .false. |
|---|
| 41 | kp = nz_in |
|---|
| 42 | DO WHILE ( (interp .eqv. .false.) .and. (kp .ge. 2) ) |
|---|
| 43 | IF( ((z_in(kp) .ge. height) .and. & |
|---|
| 44 | (z_in(kp-1) .le. height)) ) THEN |
|---|
| 45 | w2 = (height-z_in(kp))/(z_in(kp-1)-z_in(kp)) |
|---|
| 46 | w1 = 1.-w2 |
|---|
| 47 | interp_0 = w1*v_in(kp) + w2*v_in(kp-1) |
|---|
| 48 | if(debug) write(6,*) ' interp data, kp, w1, w2 ',kp, w1, w2 |
|---|
| 49 | if(debug) write(6,*) ' interp data, v_in(kp), v_in(kp-1), interp_0 ', & |
|---|
| 50 | v_in(kp), v_in(kp-1), interp_0 |
|---|
| 51 | interp = .true. |
|---|
| 52 | END IF |
|---|
| 53 | kp = kp-1 |
|---|
| 54 | ENDDO |
|---|
| 55 | ENDIF |
|---|
| 56 | |
|---|
| 57 | else |
|---|
| 58 | |
|---|
| 59 | if(debug) write(6,*) ' monotonic decrease in z in interp_0 ' |
|---|
| 60 | |
|---|
| 61 | IF (height < z_in(nz_in)) then |
|---|
| 62 | if(debug) write(6,*) ' point 1 in interp_0 ' |
|---|
| 63 | w2 = (z_in(nz_in)-height)/(z_in(nz_in)-z_in(nz_in-1)) |
|---|
| 64 | w1 = 1.-w2 |
|---|
| 65 | interp_0 = w1*v_in(nz_in) + w2*v_in(nz_in-1) |
|---|
| 66 | ELSE IF (height > z_in(1)) then |
|---|
| 67 | if(debug) write(6,*) ' point 2 in interp_0 ' |
|---|
| 68 | w2 = (z_in(2)-height)/(z_in(2)-z_in(1)) |
|---|
| 69 | w1 = 1.-w2 |
|---|
| 70 | interp_0 = w1*v_in(2) + w2*v_in(1) |
|---|
| 71 | ELSE |
|---|
| 72 | if(debug) write(6,*) ' point 3 in interp_0 ' |
|---|
| 73 | interp = .false. |
|---|
| 74 | kp = nz_in |
|---|
| 75 | height = z_out |
|---|
| 76 | DO WHILE ( (interp .eqv. .false.) .and. (kp .ge. 2) ) |
|---|
| 77 | IF( ((z_in(kp) .le. height) .and. & |
|---|
| 78 | (z_in(kp-1) .ge. height)) ) THEN |
|---|
| 79 | w2 = (height-z_in(kp))/(z_in(kp-1)-z_in(kp)) |
|---|
| 80 | w1 = 1.-w2 |
|---|
| 81 | interp_0 = w1*v_in(kp) + w2*v_in(kp-1) |
|---|
| 82 | interp = .true. |
|---|
| 83 | END IF |
|---|
| 84 | kp = kp-1 |
|---|
| 85 | ENDDO |
|---|
| 86 | ENDIF |
|---|
| 87 | |
|---|
| 88 | end if |
|---|
| 89 | |
|---|
| 90 | return |
|---|
| 91 | END FUNCTION interp_0 |
|---|
| 92 | |
|---|
| 93 | END MODULE module_init_utilities |
|---|
| 94 | |
|---|
| 95 | |
|---|
