source: lmdz_wrf/trunk/WRFV3/dyn_em/module_init_utilities.F @ 14

Last change on this file since 14 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 2.7 KB
Line 
1MODULE module_init_utilities
2
3CONTAINS
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
93END MODULE module_init_utilities
94
95
Note: See TracBrowser for help on using the repository browser.