223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

implicit none does not propagate 

each subroutine/function is independent and not part of a scope
This commit is contained in:
Martin Diehl 2022-05-27 22:34:33 +02:00
parent 2bfcc4d0b8
commit d858d753e3
4 changed files with 31 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/LAPACK_interface.f90
View File

@ -8,6 +8,8 @@ module LAPACK_interface
pure subroutine dgeev(jobvl,jobvr,n,a,lda,wr,wi,vl,ldvl,vr,ldvr,work,lwork,info)
use prec
implicit none
character, intent(in) :: jobvl,jobvr
integer, intent(in) :: n,lda,ldvl,ldvr,lwork
real(pReal), intent(inout), dimension(lda,n) :: a
@ -20,6 +22,8 @@ module LAPACK_interface
pure subroutine dgesv(n,nrhs,a,lda,ipiv,b,ldb,info)
use prec
implicit none
integer, intent(in) :: n,nrhs,lda,ldb
real(pReal), intent(inout), dimension(lda,n) :: a
integer, intent(out), dimension(n) :: ipiv
@ -29,6 +33,8 @@ module LAPACK_interface
pure subroutine dgetrf(m,n,a,lda,ipiv,info)
use prec
implicit none
integer, intent(in) :: m,n,lda
real(pReal), intent(inout), dimension(lda,n) :: a
integer, intent(out), dimension(min(m,n)) :: ipiv
@ -37,6 +43,8 @@ module LAPACK_interface
pure subroutine dgetri(n,a,lda,ipiv,work,lwork,info)
use prec
implicit none
integer, intent(in) :: n,lda,lwork
real(pReal), intent(inout), dimension(lda,n) :: a
integer, intent(in), dimension(n) :: ipiv
@ -46,6 +54,8 @@ module LAPACK_interface
pure subroutine dsyev(jobz,uplo,n,a,lda,w,work,lwork,info)
use prec
implicit none
character, intent(in) :: jobz,uplo
integer, intent(in) :: n,lda,lwork
real(pReal), intent(inout), dimension(lda,n) :: a

1
src/YAML_parse.f90
View File

@ -24,6 +24,7 @@ module YAML_parse
subroutine to_flow_C(flow,length_flow,mixed) bind(C)
use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR, C_PTR
implicit none
type(C_PTR), intent(out) :: flow
integer(C_INT), intent(out) :: length_flow

16
src/grid/zlib.f90
View File

@ -13,15 +13,14 @@ module zlib
interface
subroutine inflate_C(s_deflated,s_inflated,deflated,inflated) bind(C)
use, intrinsic :: ISO_C_Binding, only: &
C_SIGNED_CHAR, C_INT64_T
subroutine inflate_C(s_deflated,s_inflated,deflated,inflated) bind(C)
use, intrinsic :: ISO_C_Binding, only: C_SIGNED_CHAR, C_INT64_T
implicit none
integer(C_INT64_T), intent(in) :: s_deflated,s_inflated
integer(C_SIGNED_CHAR), dimension(s_deflated), intent(in) :: deflated
integer(C_SIGNED_CHAR), dimension(s_inflated), intent(out) :: inflated
end subroutine inflate_C
integer(C_INT64_T), intent(in) :: s_deflated,s_inflated
integer(C_SIGNED_CHAR), dimension(s_deflated), intent(in) :: deflated
integer(C_SIGNED_CHAR), dimension(s_inflated), intent(out) :: inflated
end subroutine inflate_C
end interface
@ -37,6 +36,7 @@ function zlib_inflate(deflated,size_inflated)
integer(C_SIGNED_CHAR), dimension(size_inflated) :: zlib_inflate
call inflate_C(size(deflated,kind=C_INT64_T),int(size_inflated,C_INT64_T),deflated,zlib_inflate)
end function zlib_inflate

15
src/system_routines.f90
View File

@ -24,8 +24,10 @@ module system_routines
interface
function setCWD_C(cwd) bind(C)
use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR
implicit none
integer(C_INT) :: setCWD_C
character(kind=C_CHAR), dimension(*), intent(in) :: cwd
@ -34,6 +36,7 @@ module system_routines
subroutine getCWD_C(cwd, stat) bind(C)
use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR
use prec
implicit none
character(kind=C_CHAR), dimension(pPathLen+1), intent(out) :: cwd ! NULL-terminated array
integer(C_INT), intent(out) :: stat
@ -42,6 +45,7 @@ module system_routines
subroutine getHostName_C(hostname, stat) bind(C)
use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR
use prec
implicit none
character(kind=C_CHAR), dimension(pStringLen+1), intent(out) :: hostname ! NULL-terminated array
integer(C_INT), intent(out) :: stat
@ -50,6 +54,7 @@ module system_routines
subroutine getUserName_C(username, stat) bind(C)
use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR
use prec
implicit none
character(kind=C_CHAR), dimension(pStringLen+1), intent(out) :: username ! NULL-terminated array
integer(C_INT), intent(out) :: stat
@ -57,27 +62,31 @@ module system_routines
subroutine signalint_C(handler) bind(C)
use, intrinsic :: ISO_C_Binding, only: C_FUNPTR
implicit none
type(C_FUNPTR), intent(in), value :: handler
end subroutine signalint_C
subroutine signalusr1_C(handler) bind(C)
use, intrinsic :: ISO_C_Binding, only: C_FUNPTR
implicit none
type(C_FUNPTR), intent(in), value :: handler
end subroutine signalusr1_C
subroutine signalusr2_C(handler) bind(C)
use, intrinsic :: ISO_C_Binding, only: C_FUNPTR
implicit none
type(C_FUNPTR), intent(in), value :: handler
end subroutine signalusr2_C
subroutine free_C(ptr) bind(C,name='free')
import c_ptr
type(c_ptr), value :: ptr
end subroutine free_C
use, intrinsic :: ISO_C_Binding, only: C_PTR
implicit none
type(C_PTR), value :: ptr
end subroutine free_C
end interface