Fortran: passing arbitrary “structures” to a module subroutine

眉间皱痕 提交于 2021-02-08 04:41:05

问题


I'm trying to write a general use subroutine for minimization. As I want to have a general purpose subroutine, the objective functions can have different parameters, not just in names, but in dimensions too. So I need a way to pass that parameter structure (I'm using the word structure because my idea is to use something like a structure type variable in Matlab). I managed to use the derived data type, which worked just fine, but the problem arises when I have two different objective functions in the same program. This is a sample code:

In the main program main.f90:

MODULE MYPAR
  IMPLICIT NONE
  TYPE PARPASS1    !! Parameter passing structure 1
     INTEGER       :: a
     REAL          :: X(2,2)
  END TYPE PARPASS1

  TYPE PARPASS2    !! Parameter passing structure 2
     REAL          :: b
     REAL          :: Y(3)
  END TYPE PARPASS2
END MODULE MYPAR

PROGRAM MAIN

  USE MYPAR
  USE MYLIB
  IMPLICIT NONE

  INTEGER        :: am
  REAL           :: bm,Xm(2,2),Ym(3),sol1,sol2
  TYPE(PARPASS1) :: PARAM1
  TYPE(PARPASS2) :: PARAM2

  am = 1
  bm = 3.5
  Xm(1,:) = [1.0, 2.0]
  Xm(2,:) = [0.5, 2.5]
  Ym(1:3) = [0.25,0.50,0.75]

  PARAM1%a = am
  PARAM1%X = Xm
  PARAM2%b = bm
  PARAM2%Y = Ym

  CALL MYSUB(sol1,OBJ1,PARAM1)
  CALL MYSUB(sol2,OBJ2,PARAM2)
  PRINT *,sol1
  PRINT *,sol2

CONTAINS

  SUBROUTINE OBJ1(sumval,PARAM)
    REAL,INTENT(OUT)          :: sumval
    TYPE(PARPASS1),INTENT(IN) :: PARAM
    INTEGER                   :: a
    REAL,ALLOCATABLE          :: X(:,:)
    a = PARAM%a
    X = PARAM%X
    sumval = a+X(1,1)+X(2,2)
  END SUBROUTINE OBJ1

  SUBROUTINE OBJ2(divval,PARAM)
    REAL,INTENT(OUT)          :: divval
    TYPE(PARPASS2),INTENT(IN) :: PARAM
    REAL                      :: b
    REAL,ALLOCATABLE          :: Y(:)
    b = PARAM%b
    Y = PARAM%Y
    divval = b / (Y(1)+Y(2))
  END SUBROUTINE OBJ2

END PROGRAM MAIN

And a module called mylib.90

MODULE MYLIB

  USE MYPAR
  IMPLICIT NONE

CONTAINS

  SUBROUTINE MYSUB(sol,FN,PARAM)
    REAL,INTENT(OUT)           :: sol
    TYPE(PARPASS1), INTENT(IN) :: PARAM
    CALL FN(sol,PARAM)
    sol = 2*sol
  END SUBROUTINE MYSUB

END MODULE MYLIB

Obviously, if I comment the lines with CALL MYSUB(sol2,OBJ2,PARAM2) and PRINT *,sol2, my code runs smoothly. This was I had before having two "objective functions", but now when I have them it doesn't work because the derived type variable PARPASS1 in MYSUB cannot be arbitrary.

Any ideas?


回答1:


You could use an interface and overload the subroutine MYSUB:

MODULE MYLIB

  USE MYPAR
  IMPLICIT NONE

  interface MYSUB
    module procedure MYSUB_PARPASS1, MYSUB_PARPASS2
  end interface

CONTAINS

  SUBROUTINE MYSUB_PARPASS1(sol,FN,PARAM)
    REAL,INTENT(OUT)           :: sol
    TYPE(PARPASS1), INTENT(IN) :: PARAM
    CALL FN(sol,PARAM)
    sol = 2*sol
  END SUBROUTINE MYSUB_PARPASS1

  SUBROUTINE MYSUB_PARPASS2(sol,FN,PARAM)
    REAL,INTENT(OUT)           :: sol
    TYPE(PARPASS2), INTENT(IN) :: PARAM
    CALL FN(sol,PARAM)
    sol = 2*sol
  END SUBROUTINE MYSUB_PARPASS2   

END MODULE MYLIB

Then you can call it by using MYSUB and it will differentiate the functions based on the TYPE of PARAM

Edit: Ok, how about this:

MODULE MYPAR
  IMPLICIT NONE

  type, abstract :: PARPASS
   contains
     procedure(func), deferred :: OBJ
  end type PARPASS

  TYPE, extends(PARPASS) :: PARPASS1    !! Parameter passing structure 1
     INTEGER       :: a
     REAL          :: X(2,2)
   contains
     procedure :: OBJ => OBJ1
  END TYPE PARPASS1

  TYPE, extends(PARPASS) :: PARPASS2    !! Parameter passing structure 2
     REAL          :: b
     REAL          :: Y(3)
   contains
     procedure :: OBJ => OBJ2
  END TYPE PARPASS2

  abstract interface
     subroutine func(this, val) !Interface for the subroutine you want to implement
       import
       class(PARPASS), intent(in) :: this
       real, intent(out) :: val
     end subroutine func
  end interface

contains

   subroutine OBJ1(this, val)
    class(PARPASS1),INTENT(IN) :: this
    real, intent(out)          :: val
    INTEGER                    :: a
    REAL,ALLOCATABLE           :: X(:,:)
    a = this%a
    X = this%X
    val = a+X(1,1)+X(2,2)
  END subroutine OBJ1

  subroutine OBJ2(this, val)
    class(PARPASS2),INTENT(IN) :: this
    real, intent(out)          :: val
    REAL                       :: b
    REAL,ALLOCATABLE           :: Y(:)
    b = this%b
    Y = this%Y
    val = b / (Y(1)+Y(2))

  END subroutine OBJ2

END MODULE MYPAR


MODULE MYLIB

  USE MYPAR
  IMPLICIT NONE

CONTAINS

  SUBROUTINE MYSUB(sol, param)
    REAL,INTENT(OUT)           :: sol
    class(PARPASS), INTENT(IN) :: PARAM
    call param%obj(sol)
    sol = 2*sol
  END SUBROUTINE MYSUB

END MODULE MYLIB

PROGRAM MAIN

  USE MYPAR
  USE MYLIB
  IMPLICIT NONE

  INTEGER        :: am
  REAL           :: bm,Xm(2,2),Ym(3),sol1,sol2
  TYPE(PARPASS1) :: PARAM1
  TYPE(PARPASS2) :: PARAM2

  am = 1
  bm = 3.5
  Xm(1,:) = [1.0, 2.0]
  Xm(2,:) = [0.5, 2.5]
  Ym(1:3) = [0.25,0.50,0.75]

  PARAM1%a = am
  PARAM1%X = Xm
  PARAM2%b = bm
  PARAM2%Y = Ym

  CALL MYSUB(sol1, PARAM1)
  CALL MYSUB(sol2, PARAM2)
  PRINT *,sol1
  PRINT *,sol2

END PROGRAM MAIN

It uses an abstract type that contains the procedure OBJ and then your derived types can extend that and implement the actual procedure. You can then pass any type that extends PARPASS and implements the type-bound procedure OBJ to 'MYSUB' and call it from within without having a separate interface for all the different possibilities.



来源:https://stackoverflow.com/questions/27083060/fortran-passing-arbitrary-structures-to-a-module-subroutine

标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!