当由R

问题描述

我在R中有一个4D数组，试图在第3维的各个层之间进行插值。为此，我使用了如下所示的Fortran子例程，它可以完美编译，但是我在R中运行它，并返回传递给它的相同的output_array。

该子例程应在单元格上循环并在要插入的键值数组input_vect中搜索给定键值inputt_array的位置，并应用三种情况：

1. 小于所有值，然后分配NaN
2. 在inputt_array的第3维中的2层之间下降，然后进行插值。
3. 该值大于所有值在inputt_array的最大键值级别分配值

    subroutine vint(input_array,input_vect,inputt_array,m,n,o,p,req,output_array)
    implicit none
    integer :: m,req
    integer :: x,y,z,t,l
    double precision :: input_vect(req),input_array(m,p),inputt_array(m,p)
    double precision :: delta_w,delta_p,grad_w_p,diff_p
    double precision,intent(out) :: output_array(m,p)
    real :: arg = -1.0
    do l = 1,req
     do t = 1,p 
      do x= 1,m
       do y =1,n 
        do z=1,o    
!above uppest level
          if(input_vect(l) .LT. inputt_array(x,t)) then 
          output_array(x,l,t) = sqrt(arg) 
              end if 
! in between levels
          if(input_vect(l) .GE. inputt_array(x,t) .AND. input_vect(l) .LE. inputt_array(x,z+1,t) ) then 
            delta_w =  input_array(x,t) - input_array(x,t)
            delta_p = inputt_array(x,t) - inputt_array(x,t)
            grad_w_p = delta_w /delta_p
            diff_p = inputt_array(x,t) - input_vect(l)
                        output_array(x,t) = input_array(x,t) +  grad_w_p * diff_p 
              end if  
! extrapolation below the lowest level  
              if(input_vect(l) .GT. inputt_array(x,1,t)) then
            
                   output_array(x,t)   
              end if
            end do 
           end do 
        end do  
       end do
      end do   
     end subroutine vint

但是，它返回的输入保持不变！

编辑：这是在R中实现子例程的方式。还有一点，似乎它可以工作，但不适用于数组的所有单元！

>   dim(input_array)
[1] 175  88  31   5
>   dim(inputt_array)
[1] 175  88  31   5
>   #load vertical interpolate subroutine 
>   dyn.load("example.so")
>   #check
>   is.loaded("vint")
[1] TRUE
 
>   DIM<-dim(input_array)
 
>   output_DIM<-c(DIM[1],DIM[2],length(input_vect),DIM[4])
>   output_array<-ff(array(0.00,dim =output_DIM),dim =output_DIM)
>   result<- array(.Fortran("vint",input_array=as.numeric(input_array[]),input_vect=as.numeric(input_vect),inputt_array=as.numeric(inputt_array[]),m=as.integer(DIM[1]),n=as.integer(DIM[2]),o=as.integer(DIM[3]),p=as.integer(DIM[4]),req = as.integer(length(input_vect)),output_array=as.numeric(output_array[]))$output_array,dim =output_DIM)
> all(result == output_array[])
[1] FALSE
 

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）