dyn_em/module_init_utilities.F

   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