Как можно передать набор значений переменных через подпрограмму в функцию без общего блока?

Question

Я не хочу использовать общие блоки в моей программе. Моя основная программа вызывает подпрограмму, которая вызывает функцию. Для функции нужны переменные из подпрограммы.

Как можно передать набор информации из подпрограммы в функцию?

program
...

call CONDAT(i,j)

end program

SUBROUTINE CONDAT(i,j)

common /contact/ iab11,iab22,xx2,yy2,zz2
common /ellip/ b1,c1,f1,g1,h1,d1,b2,c2,f2,g2,h2,p2,q2,r2,d2
call function f(x)
RETURN
END

function f(x)
common /contact/ iab11,iab22,xx2,yy2,zz2
common /ellip/ b1,c1,f1,g1,h1,d1,b2,c2,f2,g2,h2,p2,q2,r2,d2
end

Answer 1

Здесь вас интересует ассоциация: вы хотите иметь возможность связывать сущности в функции f с теми, кто в подпрограмме condat, Связывание с хранилищем является одним из способов сделать это, что делает общий блок.

Существуют и другие формы ассоциации, которые могут быть полезны. Это

• использовать ассоциацию
• принимающая ассоциация
• ассоциация аргументов

Аргументация ассоциация описана в ответе haraldkl.

Использование ассоциации происходит через такие модули, как

module global_variables
  implicit none     ! I'm guessing on declarations, but that's not important
  public   ! Which is the default
  real b1,c1,f1,g1,h1,d1,b2,c2,f2,g2,h2,p2,q2,r2,d2,xx2,yy2,zz2
  integer iab11,iab22
end module

subroutine condat(i,j)
  use global_variables   ! Those public things are use associated
  ...
end subroutine

function f(x)
  use global_variables   ! And the same entities are accessible here
  ...
end function

Хост-ассоциация имеет доступ к объектам, доступным для хоста. Хозяином здесь может быть модуль или программа

module everything
  integer iab11,...
  real ...
 contains
  subroutine condat(i,j)
    ! iab11 available from the host module
  end subroutine

  function f(x)
    ! iab11 available from the host module
  end function
end module

или даже сама подпрограмма

subroutine condat(i,j)
  integer iab11,...
  real ...
 contains
  function f(x)
    ! Host condat's iab11 is accessible here
  end function
 end subroutine

Answer 2

Ниже приведен пример того, как вы можете достичь этого...

Код был адаптирован из метода BFGS, чтобы показать, как вы можете передавать функции и вызывать другие функции внутри модуля...

Здесь я использую:

• частные функции, вложенные в другие подпрограммы
• передать переменные из подпрограммы во вложенную функцию
• передать функцию в качестве аргумента для функции, которая может быть определена вне блока модуля

Надеюсь, что это покроет все для вас...

Module Mod_Example

Private :: private_func

   SUBROUTINE test_routine(res,start,fin,vector,func,dfunc)
      IMPLICIT NONE
      REAL, DIMENSION(:), INTENT(IN) :: res, start, fin
      REAL, DIMENSION(:), INTENT(INOUT) :: vector

      INTERFACE
         FUNCTION func(vector)                                      
            IMPLICIT NONE                                      
            REAL, DIMENSION(:), INTENT(IN) :: vector                
            REAL :: func                                       
         END FUNCTION func                                     

         FUNCTION dfunc(vector)                                     
            IMPLICIT NONE                                      
            REAL, DIMENSION(:), INTENT(IN) :: vector               
            REAL, DIMENSION(size(vector)) :: dfunc                  
         END FUNCTION dfunc                                    
      END INTERFACE

      ! do stuff with p

      private_func(res,start,fin,vector,func,dfunc) 

      ! do stuff
   END SUBROUTINE test_routine

   SUBROUTINE private_func(res,start,fin,vector,func,dfunc)
      IMPLICIT NONE
      REAL, DIMENSION(:), INTENT(IN) :: res, start, fin
      REAL, DIMENSION(:), INTENT(INOUT) :: vector
      INTERFACE
         FUNCTION func(vector)            
            REAL, DIMENSION(:), INTENT(IN) :: vector
            REAL :: func
         END FUNCTION func
         FUNCTION dfunc(vector)
            REAL, DIMENSION(:), INTENT(IN) :: vector
            REAL, DIMENSION(size(vector)) :: dfunc
         END FUNCTION dfunc     
      END INTERFACE   

      ! do stuff             
   END SUBROUTINE private_func

END Mod_Example

• func а также dfunc будет объявлено в программном коде, который использует MODULE Mod_Example с интерфейсным блоком наверху.
• переменные: res, start и т.д. могут быть объявлены со значениями в главном программном блоке и переданы SUBROUTINE test_routine в качестве аргументов.
• SUBROUTINE test_routine позвоню private_func с переменными, которые были переданы ему.

Ваша основная программа будет выглядеть примерно так:

Program Main_Program
   USE Mod_Example
   INTERFACE
      FUNCTION func(vector)            
         REAL, DIMENSION(:), INTENT(IN) :: vector
         REAL :: func
      END FUNCTION func
      FUNCTION dfunc(vector)
         REAL, DIMENSION(:), INTENT(IN) :: vector
         REAL, DIMENSION(size(vector)) :: dfunc
      END FUNCTION dfunc     
   END INTERFACE

   ! do stuff       

   ! calls test_routine form module
   ! uses dfunc and func defined below
   call test_routine(res,start,fin,vector,func,dfunc)

   ! do stuff
END PROGRAM Main_Program

! define dfunc and nfunc for passing into the modular subroutine
FUNCTION func(vector)
   IMPLICIT NONE
   REAL, DIMENSION(:), INTENT(IN) :: vector
   REAL :: func

   nfunc = vector
END FUNCTION func

FUNCTION dfunc(vector)
   IMPLICIT NONE
   REAL, DIMENSION(:), INTENT(IN) :: vector
   REAL, DIMENSION(size(vector)) :: dfunc   

   dfunc = vector
END FUNCTION dfunc

Answer 3

Таким образом, в основном вы могли бы решить это с чем-то вроде этого:

SUBROUTINE CONDACT(i,j, iab11,iab22,xx2,yy2,zz2,b1,c1,f1,g1,h1,d1,b2,c2,f2,g2,h2,p2,q2,r2,d2,res)
  !declaration to all those parameters and res
  res = f(x)
END SUBROUTINE CONDACT

function f(x,iab11,iab22,xx2,yy2,zz2,b1,c1,f1,g1,h1,d1,b2,c2,f2,g2,h2,p2,q2,r2,d2)
!declaration to all those parameters
end function f

program
  ...

  call CONDAT(i,j,iab11,iab22,xx2,yy2,zz2,b1,c1,f1,g1,h1,d1,b2,c2,f2,g2,h2,p2,q2,r2,d2,res)

end program

То есть, просто передавая параметры. Настоятельно рекомендуется использовать модули, см. Ответ Александра Макфарлейна, хотя это и не обязательно. Александр Макфарлейн показывает, как передать f в качестве аргумента подпрограмме, чтобы вы могли использовать разные функции в подпрограмме, но ваш код, похоже, не требует этого.

Теперь, это ужасно длинный список параметров, и вы, вероятно, не хотите постоянно их переносить. Обычный подход для решения этой проблемы - поместить эти параметры в производный тип данных, а затем просто передать их. Как это:

!> A module implementing ellip related stuff.
module ellip_module

  implicit none

  type ellip_type
    !whatever datatypes these need to be...
    integer :: b1,c1,f1,g1,h1,d1,b2,c2,f2,g2,h2,p2,q2,r2,d2
  end type
end module ellip_module


!> A module implementing condact related stuff.
module condact_module
  use ellip_module ! Make use of the ellip module to have the type available

  implicit none

  type condact_type
    !whatever datatypes these need to be...
    integer :: iab11,iab22,xx2,yy2,zz2
  end type

  contains

  subroutine condact(i,j, con, ellip, res)
     integer :: i,j
     type(condact_type) :: con
     type(ellip_type) :: ellip
     real :: res

     real :: x
     res = f(x, con, ellip)
  end subroutine condact

  function f(x, con, ellip) result(res)
    real :: x
    real :: res
    type(condact_type) :: con
    type(ellip_type) :: ellip

    res = !whatever this should do
  end function f
end module condact_module


!> A program using the condact functionality.
program test_condact
  use ellip_module
  use condact_module

  implicit none

  type(condact_type) :: mycon
  type(ellip_type) :: myellip
  integer :: i,j
  real :: res

  call condact(i,j, mycon, myellip, res)
end program test_condact

Это всего лишь грубый набросок, но у меня сложилось впечатление, что это то, что вы ищете.