!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!  This file is AUTOMATICALLY GENERATED by:
!!  ../tools/fortran_wrappers.pl ../include/magma_c.i
!!  Do not edit.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

module magma_cfortran

use magma_param

implicit none

!---- Fortran interfaces to MAGMA subroutines ----
interface

integer function magmaf_get_cpotrf_nb( m )
    integer :: m
end function magmaf_get_cpotrf_nb

integer function magmaf_get_cgetrf_nb( m )
    integer :: m
end function magmaf_get_cgetrf_nb

integer function magmaf_get_cgetri_nb( m )
    integer :: m
end function magmaf_get_cgetri_nb

integer function magmaf_get_cgeqp3_nb( m )
    integer :: m
end function magmaf_get_cgeqp3_nb

integer function magmaf_get_cgeqrf_nb( m )
    integer :: m
end function magmaf_get_cgeqrf_nb

integer function magmaf_get_cgeqlf_nb( m )
    integer :: m
end function magmaf_get_cgeqlf_nb

integer function magmaf_get_cgehrd_nb( m )
    integer :: m
end function magmaf_get_cgehrd_nb

integer function magmaf_get_chetrd_nb( m )
    integer :: m
end function magmaf_get_chetrd_nb

integer function magmaf_get_chetrf_nb( m )
    integer :: m
end function magmaf_get_chetrf_nb

integer function magmaf_get_chetrf_nopiv_nb( m )
    integer :: m
end function magmaf_get_chetrf_nopiv_nb

integer function magmaf_get_cgelqf_nb( m )
    integer :: m
end function magmaf_get_cgelqf_nb

integer function magmaf_get_cgebrd_nb( m )
    integer :: m
end function magmaf_get_cgebrd_nb

integer function magmaf_get_chegst_nb( m )
    integer :: m
end function magmaf_get_chegst_nb

integer function magmaf_get_cgesvd_nb( m )
    integer :: m
end function magmaf_get_cgesvd_nb

integer function magmaf_get_chegst_nb_m( m )
    integer :: m
end function magmaf_get_chegst_nb_m

subroutine magmaf_get_cbulge_nb( m, nbthreads )
    integer          :: m
    integer          :: nbthreads
end subroutine magmaf_get_cbulge_nb

subroutine magmaf_cbulge_get_Vblksiz( m, nb, nbthreads )
    integer          :: m
    integer          :: nb
    integer          :: nbthreads
end subroutine magmaf_cbulge_get_Vblksiz

subroutine magmaf_get_cbulge_gcperf(  )
end subroutine magmaf_get_cbulge_gcperf

subroutine magmaf_cgebrd( m, n, A, lda, d, e, tauq, taup, work, lwork, info )
    integer          :: m
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    real             :: d(*)
    real             :: e(*)
    complex          :: tauq(*)
    complex          :: taup(*)
    complex          :: work(*)
    integer          :: lwork
    integer          :: info
end subroutine magmaf_cgebrd

subroutine magmaf_cgeev( jobvl, jobvr, n, A, lda, w, VL, ldvl, VR, ldvr, work, lwork,  &
        rwork, info )
    character        :: jobvl
    character        :: jobvr
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    complex          :: w(*)
    complex          :: VL(*)
    integer          :: ldvl
    complex          :: VR(*)
    integer          :: ldvr
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: info
end subroutine magmaf_cgeev

subroutine magmaf_cgehrd( n, ilo, ihi, A, lda, tau, work, lwork, dT, info )
    integer          :: n
    integer          :: ilo
    integer          :: ihi
    complex          :: A(*)
    integer          :: lda
    complex          :: tau(*)
    complex          :: work(*)
    integer          :: lwork
    magma_devptr_t   :: dT
    integer          :: info
end subroutine magmaf_cgehrd

subroutine magmaf_cgehrd2( n, ilo, ihi, A, lda, tau, work, lwork, info )
    integer          :: n
    integer          :: ilo
    integer          :: ihi
    complex          :: A(*)
    integer          :: lda
    complex          :: tau(*)
    complex          :: work(*)
    integer          :: lwork
    integer          :: info
end subroutine magmaf_cgehrd2

subroutine magmaf_cgelqf( m, n, A, lda, tau, work, lwork, info )
    integer          :: m
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    complex          :: tau(*)
    complex          :: work(*)
    integer          :: lwork
    integer          :: info
end subroutine magmaf_cgelqf

subroutine magmaf_cgeqlf( m, n, A, lda, tau, work, lwork, info )
    integer          :: m
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    complex          :: tau(*)
    complex          :: work(*)
    integer          :: lwork
    integer          :: info
end subroutine magmaf_cgeqlf

subroutine magmaf_cgeqp3( m, n, A, lda, jpvt, tau, work, lwork, rwork, info )
    integer          :: m
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    integer          :: jpvt(*)
    complex          :: tau(*)
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: info
end subroutine magmaf_cgeqp3

subroutine magmaf_cgeqrf( m, n, A, lda, tau, work, lwork, info )
    integer          :: m
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    complex          :: tau(*)
    complex          :: work(*)
    integer          :: lwork
    integer          :: info
end subroutine magmaf_cgeqrf

subroutine magmaf_cgeqrf_ooc( m, n, A, lda, tau, work, lwork, info )
    integer          :: m
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    complex          :: tau(*)
    complex          :: work(*)
    integer          :: lwork
    integer          :: info
end subroutine magmaf_cgeqrf_ooc

subroutine magmaf_cgeqrf4( ngpu, m, n, A, lda, tau, work, lwork, info )
    integer          :: ngpu
    integer          :: m
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    complex          :: tau(*)
    complex          :: work(*)
    integer          :: lwork
    integer          :: info
end subroutine magmaf_cgeqrf4

subroutine magmaf_cgesdd( jobz, m, n, A, lda, s, U, ldu, VT, ldvt, work, lwork, rwork,  &
        iwork, info )
    character        :: jobz
    integer          :: m
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    real             :: s(*)
    complex          :: U(*)
    integer          :: ldu
    complex          :: VT(*)
    integer          :: ldvt
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: iwork(*)
    integer          :: info
end subroutine magmaf_cgesdd

subroutine magmaf_cgesv( n, nrhs, A, lda, ipiv, B, ldb, info )
    integer          :: n
    integer          :: nrhs
    complex          :: A(*)
    integer          :: lda
    integer          :: ipiv(*)
    complex          :: B(*)
    integer          :: ldb
    integer          :: info
end subroutine magmaf_cgesv

subroutine magmaf_cgesv_rbt( ref, n, nrhs, A, lda, B, ldb, info )
    character        :: ref
    integer          :: n
    integer          :: nrhs
    complex          :: A(*)
    integer          :: lda
    complex          :: B(*)
    integer          :: ldb
    integer          :: info
end subroutine magmaf_cgesv_rbt

subroutine magmaf_cgesvd( jobu, jobvt, m, n, A, lda, s, U, ldu, VT, ldvt, work, lwork,  &
        rwork, info )
    character        :: jobu
    character        :: jobvt
    integer          :: m
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    real             :: s(*)
    complex          :: U(*)
    integer          :: ldu
    complex          :: VT(*)
    integer          :: ldvt
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: info
end subroutine magmaf_cgesvd

subroutine magmaf_cgetf2_nopiv( m, n, A, lda, info )
    integer          :: m
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    integer          :: info
end subroutine magmaf_cgetf2_nopiv

subroutine magmaf_cgetrf( m, n, A, lda, ipiv, info )
    integer          :: m
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    integer          :: ipiv(*)
    integer          :: info
end subroutine magmaf_cgetrf

subroutine magmaf_cgetrf_nopiv( m, n, A, lda, info )
    integer          :: m
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    integer          :: info
end subroutine magmaf_cgetrf_nopiv

subroutine magmaf_cgetrf_piv( m, n, NB, A, lda, ipiv, info )
    integer          :: m
    integer          :: n
    integer          :: NB
    complex          :: A(*)
    integer          :: lda
    integer          :: ipiv(*)
    integer          :: info
end subroutine magmaf_cgetrf_piv

subroutine magmaf_cheevd( jobz, uplo, n, A, lda, w, work, lwork, rwork, lrwork, iwork,  &
        liwork, info )
    character        :: jobz
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    real             :: w(*)
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: lrwork
    integer          :: iwork(*)
    integer          :: liwork
    integer          :: info
end subroutine magmaf_cheevd

subroutine magmaf_cheevdx( jobz, range, uplo, n, A, lda, vl, vu, il, iu, m, w, work,  &
        lwork, rwork, lrwork, iwork, liwork, info )
    character        :: jobz
    character        :: range
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    real             :: vl
    real             :: vu
    integer          :: il
    integer          :: iu
    integer          :: m
    real             :: w(*)
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: lrwork
    integer          :: iwork(*)
    integer          :: liwork
    integer          :: info
end subroutine magmaf_cheevdx

subroutine magmaf_cheevdx_2stage( jobz, range, uplo, n, A, lda, vl, vu, il, iu, m, w,  &
        work, lwork, rwork, lrwork, iwork, liwork, info )
    character        :: jobz
    character        :: range
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    real             :: vl
    real             :: vu
    integer          :: il
    integer          :: iu
    integer          :: m
    real             :: w(*)
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: lrwork
    integer          :: iwork(*)
    integer          :: liwork
    integer          :: info
end subroutine magmaf_cheevdx_2stage

subroutine magmaf_cheevr( jobz, range, uplo, n, A, lda, vl, vu, il, iu, abstol, m, w, Z,  &
        ldz, isuppz, work, lwork, rwork, lrwork, iwork, liwork, info )
    character        :: jobz
    character        :: range
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    real             :: vl
    real             :: vu
    integer          :: il
    integer          :: iu
    real             :: abstol
    integer          :: m
    real             :: w(*)
    complex          :: Z(*)
    integer          :: ldz
    integer          :: isuppz(*)
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: lrwork
    integer          :: iwork(*)
    integer          :: liwork
    integer          :: info
end subroutine magmaf_cheevr

subroutine magmaf_cheevx( jobz, range, uplo, n, A, lda, vl, vu, il, iu, abstol, m, w, Z,  &
        ldz, work, lwork, rwork, iwork, ifail, info )
    character        :: jobz
    character        :: range
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    real             :: vl
    real             :: vu
    integer          :: il
    integer          :: iu
    real             :: abstol
    integer          :: m
    real             :: w(*)
    complex          :: Z(*)
    integer          :: ldz
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: iwork(*)
    integer          :: ifail(*)
    integer          :: info
end subroutine magmaf_cheevx

subroutine magmaf_chegst( itype, uplo, n, A, lda, B, ldb, info )
    integer          :: itype
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    complex          :: B(*)
    integer          :: ldb
    integer          :: info
end subroutine magmaf_chegst

subroutine magmaf_chegvd( itype, jobz, uplo, n, A, lda, B, ldb, w, work, lwork, rwork,  &
        lrwork, iwork, liwork, info )
    integer          :: itype
    character        :: jobz
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    complex          :: B(*)
    integer          :: ldb
    real             :: w(*)
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: lrwork
    integer          :: iwork(*)
    integer          :: liwork
    integer          :: info
end subroutine magmaf_chegvd

subroutine magmaf_chegvdx( itype, jobz, range, uplo, n, A, lda, B, ldb, vl, vu, il, iu,  &
        m, w, work, lwork, rwork, lrwork, iwork, liwork, info )
    integer          :: itype
    character        :: jobz
    character        :: range
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    complex          :: B(*)
    integer          :: ldb
    real             :: vl
    real             :: vu
    integer          :: il
    integer          :: iu
    integer          :: m
    real             :: w(*)
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: lrwork
    integer          :: iwork(*)
    integer          :: liwork
    integer          :: info
end subroutine magmaf_chegvdx

subroutine magmaf_chegvdx_2stage( itype, jobz, range, uplo, n, A, lda, B, ldb, vl, vu,  &
        il, iu, m, w, work, lwork, rwork, lrwork, iwork, liwork, info )
    integer          :: itype
    character        :: jobz
    character        :: range
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    complex          :: B(*)
    integer          :: ldb
    real             :: vl
    real             :: vu
    integer          :: il
    integer          :: iu
    integer          :: m
    real             :: w(*)
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: lrwork
    integer          :: iwork(*)
    integer          :: liwork
    integer          :: info
end subroutine magmaf_chegvdx_2stage

subroutine magmaf_chegvr( itype, jobz, range, uplo, n, A, lda, B, ldb, vl, vu, il, iu,  &
        abstol, m, w, Z, ldz, isuppz, work, lwork, rwork, lrwork, iwork, liwork, info )
    integer          :: itype
    character        :: jobz
    character        :: range
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    complex          :: B(*)
    integer          :: ldb
    real             :: vl
    real             :: vu
    integer          :: il
    integer          :: iu
    real             :: abstol
    integer          :: m
    real             :: w(*)
    complex          :: Z(*)
    integer          :: ldz
    integer          :: isuppz(*)
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: lrwork
    integer          :: iwork(*)
    integer          :: liwork
    integer          :: info
end subroutine magmaf_chegvr

subroutine magmaf_chegvx( itype, jobz, range, uplo, n, A, lda, B, ldb, vl, vu, il, iu,  &
        abstol, m, w, Z, ldz, work, lwork, rwork, iwork, ifail, info )
    integer          :: itype
    character        :: jobz
    character        :: range
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    complex          :: B(*)
    integer          :: ldb
    real             :: vl
    real             :: vu
    integer          :: il
    integer          :: iu
    real             :: abstol
    integer          :: m
    real             :: w(*)
    complex          :: Z(*)
    integer          :: ldz
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: iwork(*)
    integer          :: ifail(*)
    integer          :: info
end subroutine magmaf_chegvx

subroutine magmaf_chesv( uplo, n, nrhs, A, lda, ipiv, B, ldb, info )
    character        :: uplo
    integer          :: n
    integer          :: nrhs
    complex          :: A(*)
    integer          :: lda
    integer          :: ipiv(*)
    complex          :: B(*)
    integer          :: ldb
    integer          :: info
end subroutine magmaf_chesv

subroutine magmaf_chetrd( uplo, n, A, lda, d, e, tau, work, lwork, info )
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    real             :: d(*)
    real             :: e(*)
    complex          :: tau(*)
    complex          :: work(*)
    integer          :: lwork
    integer          :: info
end subroutine magmaf_chetrd

subroutine magmaf_chetrf( uplo, n, A, lda, ipiv, info )
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    integer          :: ipiv(*)
    integer          :: info
end subroutine magmaf_chetrf

subroutine magmaf_chetrf_nopiv( uplo, n, a, lda, info )
    character        :: uplo
    integer          :: n
    complex          :: a(*)
    integer          :: lda
    integer          :: info
end subroutine magmaf_chetrf_nopiv

subroutine magmaf_chetrd_hb2st( uplo, n, nb, Vblksiz, A, lda, d, e, V, ldv, TAU, compT,  &
        T, ldt )
    character        :: uplo
    integer          :: n
    integer          :: nb
    integer          :: Vblksiz
    complex          :: A(*)
    integer          :: lda
    real             :: d(*)
    real             :: e(*)
    complex          :: V(*)
    integer          :: ldv
    complex          :: TAU(*)
    integer          :: compT
    complex          :: T(*)
    integer          :: ldt
end subroutine magmaf_chetrd_hb2st

subroutine magmaf_chetrd_he2hb( uplo, n, nb, A, lda, tau, work, lwork, dT, info )
    character        :: uplo
    integer          :: n
    integer          :: nb
    complex          :: A(*)
    integer          :: lda
    complex          :: tau(*)
    complex          :: work(*)
    integer          :: lwork
    magma_devptr_t   :: dT
    integer          :: info
end subroutine magmaf_chetrd_he2hb

subroutine magmaf_clatrsd( uplo, trans, diag, normin, n, A, lda, lambda, x, scale, cnorm,  &
        info )
    character        :: uplo
    character        :: trans
    character        :: diag
    character        :: normin
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    complex          :: lambda
    complex          :: x(*)
    real             :: scale(*)
    real             :: cnorm(*)
    integer          :: info
end subroutine magmaf_clatrsd

subroutine magmaf_clauum( uplo, n, A, lda, info )
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    integer          :: info
end subroutine magmaf_clauum

subroutine magmaf_cposv( uplo, n, nrhs, A, lda, B, ldb, info )
    character        :: uplo
    integer          :: n
    integer          :: nrhs
    complex          :: A(*)
    integer          :: lda
    complex          :: B(*)
    integer          :: ldb
    integer          :: info
end subroutine magmaf_cposv

subroutine magmaf_cpotrf( uplo, n, A, lda, info )
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    integer          :: info
end subroutine magmaf_cpotrf

subroutine magmaf_cpotri( uplo, n, A, lda, info )
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    integer          :: info
end subroutine magmaf_cpotri

subroutine magmaf_cstedx( range, n, vl, vu, il, iu, d, e, Z, ldz, rwork, lrwork, iwork,  &
        liwork, dwork, info )
    character        :: range
    integer          :: n
    real             :: vl
    real             :: vu
    integer          :: il
    integer          :: iu
    real             :: d(*)
    real             :: e(*)
    complex          :: Z(*)
    integer          :: ldz
    real             :: rwork(*)
    integer          :: lrwork
    integer          :: iwork(*)
    integer          :: liwork
    magma_devptr_t   :: dwork
    integer          :: info
end subroutine magmaf_cstedx

subroutine magmaf_ctrevc3( side, howmany, select, n, T, ldt, VL, ldvl, VR, ldvr, mm,  &
        mout, work, lwork, rwork, info )
    character        :: side
    character        :: howmany
    integer          :: select(*)
    integer          :: n
    complex          :: T(*)
    integer          :: ldt
    complex          :: VL(*)
    integer          :: ldvl
    complex          :: VR(*)
    integer          :: ldvr
    integer          :: mm
    integer          :: mout(*)
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: info
end subroutine magmaf_ctrevc3

subroutine magmaf_ctrevc3_mt( side, howmany, select, n, T, ldt, VL, ldvl, VR, ldvr, mm,  &
        mout, work, lwork, rwork, info )
    character        :: side
    character        :: howmany
    integer          :: select(*)
    integer          :: n
    complex          :: T(*)
    integer          :: ldt
    complex          :: VL(*)
    integer          :: ldvl
    complex          :: VR(*)
    integer          :: ldvr
    integer          :: mm
    integer          :: mout(*)
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: info
end subroutine magmaf_ctrevc3_mt

subroutine magmaf_ctrtri( uplo, diag, n, A, lda, info )
    character        :: uplo
    character        :: diag
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    integer          :: info
end subroutine magmaf_ctrtri

subroutine magmaf_cunghr( n, ilo, ihi, A, lda, tau, dT, nb, info )
    integer          :: n
    integer          :: ilo
    integer          :: ihi
    complex          :: A(*)
    integer          :: lda
    complex          :: tau(*)
    magma_devptr_t   :: dT
    integer          :: nb
    integer          :: info
end subroutine magmaf_cunghr

subroutine magmaf_cungqr( m, n, k, A, lda, tau, dT, nb, info )
    integer          :: m
    integer          :: n
    integer          :: k
    complex          :: A(*)
    integer          :: lda
    complex          :: tau(*)
    magma_devptr_t   :: dT
    integer          :: nb
    integer          :: info
end subroutine magmaf_cungqr

subroutine magmaf_cungqr2( m, n, k, A, lda, tau, info )
    integer          :: m
    integer          :: n
    integer          :: k
    complex          :: A(*)
    integer          :: lda
    complex          :: tau(*)
    integer          :: info
end subroutine magmaf_cungqr2

subroutine magmaf_cunmbr( vect, side, trans, m, n, k, A, lda, tau, C, ldc, work, lwork,  &
        info )
    character        :: vect
    character        :: side
    character        :: trans
    integer          :: m
    integer          :: n
    integer          :: k
    complex          :: A(*)
    integer          :: lda
    complex          :: tau(*)
    complex          :: C(*)
    integer          :: ldc
    complex          :: work(*)
    integer          :: lwork
    integer          :: info
end subroutine magmaf_cunmbr

subroutine magmaf_cunmlq( side, trans, m, n, k, A, lda, tau, C, ldc, work, lwork, info )
    character        :: side
    character        :: trans
    integer          :: m
    integer          :: n
    integer          :: k
    complex          :: A(*)
    integer          :: lda
    complex          :: tau(*)
    complex          :: C(*)
    integer          :: ldc
    complex          :: work(*)
    integer          :: lwork
    integer          :: info
end subroutine magmaf_cunmlq

subroutine magmaf_cunmql( side, trans, m, n, k, A, lda, tau, C, ldc, work, lwork, info )
    character        :: side
    character        :: trans
    integer          :: m
    integer          :: n
    integer          :: k
    complex          :: A(*)
    integer          :: lda
    complex          :: tau(*)
    complex          :: C(*)
    integer          :: ldc
    complex          :: work(*)
    integer          :: lwork
    integer          :: info
end subroutine magmaf_cunmql

subroutine magmaf_cunmqr( side, trans, m, n, k, A, lda, tau, C, ldc, work, lwork, info )
    character        :: side
    character        :: trans
    integer          :: m
    integer          :: n
    integer          :: k
    complex          :: A(*)
    integer          :: lda
    complex          :: tau(*)
    complex          :: C(*)
    integer          :: ldc
    complex          :: work(*)
    integer          :: lwork
    integer          :: info
end subroutine magmaf_cunmqr

subroutine magmaf_cunmtr( side, uplo, trans, m, n, A, lda, tau, C, ldc, work, lwork, info  &
        )
    character        :: side
    character        :: uplo
    character        :: trans
    integer          :: m
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    complex          :: tau(*)
    complex          :: C(*)
    integer          :: ldc
    complex          :: work(*)
    integer          :: lwork
    integer          :: info
end subroutine magmaf_cunmtr

subroutine magmaf_cgeev_m( jobvl, jobvr, n, A, lda, w, VL, ldvl, VR, ldvr, work, lwork,  &
        rwork, info )
    character        :: jobvl
    character        :: jobvr
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    complex          :: w(*)
    complex          :: VL(*)
    integer          :: ldvl
    complex          :: VR(*)
    integer          :: ldvr
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: info
end subroutine magmaf_cgeev_m

subroutine magmaf_cgehrd_m( n, ilo, ihi, A, lda, tau, work, lwork, T, info )
    integer          :: n
    integer          :: ilo
    integer          :: ihi
    complex          :: A(*)
    integer          :: lda
    complex          :: tau(*)
    complex          :: work(*)
    integer          :: lwork
    complex          :: T(*)
    integer          :: info
end subroutine magmaf_cgehrd_m

subroutine magmaf_cgetrf_m( ngpu, m, n, A, lda, ipiv, info )
    integer          :: ngpu
    integer          :: m
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    integer          :: ipiv(*)
    integer          :: info
end subroutine magmaf_cgetrf_m

subroutine magmaf_cheevd_m( ngpu, jobz, uplo, n, A, lda, w, work, lwork, rwork, lrwork,  &
        iwork, liwork, info )
    integer          :: ngpu
    character        :: jobz
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    real             :: w(*)
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: lrwork
    integer          :: iwork(*)
    integer          :: liwork
    integer          :: info
end subroutine magmaf_cheevd_m

subroutine magmaf_cheevdx_2stage_m( ngpu, jobz, range, uplo, n, A, lda, vl, vu, il, iu,  &
        m, w, work, lwork, rwork, lrwork, iwork, liwork, info )
    integer          :: ngpu
    character        :: jobz
    character        :: range
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    real             :: vl
    real             :: vu
    integer          :: il
    integer          :: iu
    integer          :: m
    real             :: w(*)
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: lrwork
    integer          :: iwork(*)
    integer          :: liwork
    integer          :: info
end subroutine magmaf_cheevdx_2stage_m

subroutine magmaf_cheevdx_m( ngpu, jobz, range, uplo, n, A, lda, vl, vu, il, iu, m, w,  &
        work, lwork, rwork, lrwork, iwork, liwork, info )
    integer          :: ngpu
    character        :: jobz
    character        :: range
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    real             :: vl
    real             :: vu
    integer          :: il
    integer          :: iu
    integer          :: m
    real             :: w(*)
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: lrwork
    integer          :: iwork(*)
    integer          :: liwork
    integer          :: info
end subroutine magmaf_cheevdx_m

subroutine magmaf_chegst_m( ngpu, itype, uplo, n, A, lda, B, ldb, info )
    integer          :: ngpu
    integer          :: itype
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    complex          :: B(*)
    integer          :: ldb
    integer          :: info
end subroutine magmaf_chegst_m

subroutine magmaf_chegvd_m( ngpu, itype, jobz, uplo, n, A, lda, B, ldb, w, work, lwork,  &
        rwork, lrwork, iwork, liwork, info )
    integer          :: ngpu
    integer          :: itype
    character        :: jobz
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    complex          :: B(*)
    integer          :: ldb
    real             :: w(*)
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: lrwork
    integer          :: iwork(*)
    integer          :: liwork
    integer          :: info
end subroutine magmaf_chegvd_m

subroutine magmaf_chegvdx_2stage_m( ngpu, itype, jobz, range, uplo, n, A, lda, B, ldb,  &
        vl, vu, il, iu, m, w, work, lwork, rwork, lrwork, iwork, liwork, info )
    integer          :: ngpu
    integer          :: itype
    character        :: jobz
    character        :: range
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    complex          :: B(*)
    integer          :: ldb
    real             :: vl
    real             :: vu
    integer          :: il
    integer          :: iu
    integer          :: m
    real             :: w(*)
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: lrwork
    integer          :: iwork(*)
    integer          :: liwork
    integer          :: info
end subroutine magmaf_chegvdx_2stage_m

subroutine magmaf_chegvdx_m( ngpu, itype, jobz, range, uplo, n, A, lda, B, ldb, vl, vu,  &
        il, iu, m, w, work, lwork, rwork, lrwork, iwork, liwork, info )
    integer          :: ngpu
    integer          :: itype
    character        :: jobz
    character        :: range
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    complex          :: B(*)
    integer          :: ldb
    real             :: vl
    real             :: vu
    integer          :: il
    integer          :: iu
    integer          :: m
    real             :: w(*)
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: lrwork
    integer          :: iwork(*)
    integer          :: liwork
    integer          :: info
end subroutine magmaf_chegvdx_m

subroutine magmaf_cpotrf_m( ngpu, uplo, n, A, lda, info )
    integer          :: ngpu
    character        :: uplo
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    integer          :: info
end subroutine magmaf_cpotrf_m

subroutine magmaf_cstedx_m( ngpu, range, n, vl, vu, il, iu, d, e, Z, ldz, rwork, lrwork,  &
        iwork, liwork, info )
    integer          :: ngpu
    character        :: range
    integer          :: n
    real             :: vl
    real             :: vu
    integer          :: il
    integer          :: iu
    real             :: d(*)
    real             :: e(*)
    complex          :: Z(*)
    integer          :: ldz
    real             :: rwork(*)
    integer          :: lrwork
    integer          :: iwork(*)
    integer          :: liwork
    integer          :: info
end subroutine magmaf_cstedx_m

subroutine magmaf_ctrsm_m( ngpu, side, uplo, transa, diag, m, n, alpha, A, lda, B, ldb )
    integer          :: ngpu
    character        :: side
    character        :: uplo
    character        :: transa
    character        :: diag
    integer          :: m
    integer          :: n
    complex          :: alpha
    complex          :: A(*)
    integer          :: lda
    complex          :: B(*)
    integer          :: ldb
end subroutine magmaf_ctrsm_m

subroutine magmaf_cunghr_m( n, ilo, ihi, A, lda, tau, T, nb, info )
    integer          :: n
    integer          :: ilo
    integer          :: ihi
    complex          :: A(*)
    integer          :: lda
    complex          :: tau(*)
    complex          :: T(*)
    integer          :: nb
    integer          :: info
end subroutine magmaf_cunghr_m

subroutine magmaf_cungqr_m( m, n, k, A, lda, tau, T, nb, info )
    integer          :: m
    integer          :: n
    integer          :: k
    complex          :: A(*)
    integer          :: lda
    complex          :: tau(*)
    complex          :: T(*)
    integer          :: nb
    integer          :: info
end subroutine magmaf_cungqr_m

subroutine magmaf_cunmqr_m( ngpu, side, trans, m, n, k, A, lda, tau, C, ldc, work, lwork,  &
        info )
    integer          :: ngpu
    character        :: side
    character        :: trans
    integer          :: m
    integer          :: n
    integer          :: k
    complex          :: A(*)
    integer          :: lda
    complex          :: tau(*)
    complex          :: C(*)
    integer          :: ldc
    complex          :: work(*)
    integer          :: lwork
    integer          :: info
end subroutine magmaf_cunmqr_m

subroutine magmaf_cunmtr_m( ngpu, side, uplo, trans, m, n, A, lda, tau, C, ldc, work,  &
        lwork, info )
    integer          :: ngpu
    character        :: side
    character        :: uplo
    character        :: trans
    integer          :: m
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    complex          :: tau(*)
    complex          :: C(*)
    integer          :: ldc
    complex          :: work(*)
    integer          :: lwork
    integer          :: info
end subroutine magmaf_cunmtr_m

subroutine magmaf_cgegqr_gpu( ikind, m, n, dA, ldda, dwork, work, info )
    integer          :: ikind
    integer          :: m
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    magma_devptr_t   :: dwork
    complex          :: work(*)
    integer          :: info
end subroutine magmaf_cgegqr_gpu

subroutine magmaf_cgelqf_gpu( m, n, dA, ldda, tau, work, lwork, info )
    integer          :: m
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    complex          :: tau(*)
    complex          :: work(*)
    integer          :: lwork
    integer          :: info
end subroutine magmaf_cgelqf_gpu

subroutine magmaf_cgels_gpu( trans, m, n, nrhs, dA, ldda, dB, lddb, hwork, lwork, info )
    character        :: trans
    integer          :: m
    integer          :: n
    integer          :: nrhs
    magma_devptr_t   :: dA
    integer          :: ldda
    magma_devptr_t   :: dB
    integer          :: lddb
    complex          :: hwork(*)
    integer          :: lwork
    integer          :: info
end subroutine magmaf_cgels_gpu

subroutine magmaf_cgels3_gpu( trans, m, n, nrhs, dA, ldda, dB, lddb, hwork, lwork, info )
    character        :: trans
    integer          :: m
    integer          :: n
    integer          :: nrhs
    magma_devptr_t   :: dA
    integer          :: ldda
    magma_devptr_t   :: dB
    integer          :: lddb
    complex          :: hwork(*)
    integer          :: lwork
    integer          :: info
end subroutine magmaf_cgels3_gpu

subroutine magmaf_cgeqp3_gpu( m, n, dA, ldda, jpvt, tau, dwork, lwork, rwork, info )
    integer          :: m
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    integer          :: jpvt(*)
    complex          :: tau(*)
    magma_devptr_t   :: dwork
    integer          :: lwork
    real             :: rwork(*)
    integer          :: info
end subroutine magmaf_cgeqp3_gpu

subroutine magmaf_cgeqr2x_gpu( m, n, dA, ldda, dtau, dT, ddA, dwork, info )
    integer          :: m
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    magma_devptr_t   :: dtau
    magma_devptr_t   :: dT
    magma_devptr_t   :: ddA
    magma_devptr_t   :: dwork
    integer          :: info
end subroutine magmaf_cgeqr2x_gpu

subroutine magmaf_cgeqr2x2_gpu( m, n, dA, ldda, dtau, dT, ddA, dwork, info )
    integer          :: m
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    magma_devptr_t   :: dtau
    magma_devptr_t   :: dT
    magma_devptr_t   :: ddA
    magma_devptr_t   :: dwork
    integer          :: info
end subroutine magmaf_cgeqr2x2_gpu

subroutine magmaf_cgeqr2x3_gpu( m, n, dA, ldda, dtau, dT, ddA, dwork, info )
    integer          :: m
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    magma_devptr_t   :: dtau
    magma_devptr_t   :: dT
    magma_devptr_t   :: ddA
    magma_devptr_t   :: dwork
    integer          :: info
end subroutine magmaf_cgeqr2x3_gpu

subroutine magmaf_cgeqr2x4_gpu( m, n, dA, ldda, dtau, dT, ddA, dwork, queue, info )
    integer          :: m
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    magma_devptr_t   :: dtau
    magma_devptr_t   :: dT
    magma_devptr_t   :: ddA
    magma_devptr_t   :: dwork
    integer          :: queue
    integer          :: info
end subroutine magmaf_cgeqr2x4_gpu

subroutine magmaf_cgeqrf_gpu( m, n, dA, ldda, tau, dT, info )
    integer          :: m
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    complex          :: tau(*)
    magma_devptr_t   :: dT
    integer          :: info
end subroutine magmaf_cgeqrf_gpu

subroutine magmaf_cgeqrf2_gpu( m, n, dA, ldda, tau, info )
    integer          :: m
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    complex          :: tau(*)
    integer          :: info
end subroutine magmaf_cgeqrf2_gpu

subroutine magmaf_cgeqrf3_gpu( m, n, dA, ldda, tau, dT, info )
    integer          :: m
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    complex          :: tau(*)
    magma_devptr_t   :: dT
    integer          :: info
end subroutine magmaf_cgeqrf3_gpu

subroutine magmaf_cgeqrs_gpu( m, n, nrhs, dA, ldda, tau, dT, dB, lddb, hwork, lwork, info  &
        )
    integer          :: m
    integer          :: n
    integer          :: nrhs
    magma_devptr_t   :: dA
    integer          :: ldda
    complex          :: tau(*)
    magma_devptr_t   :: dT
    magma_devptr_t   :: dB
    integer          :: lddb
    complex          :: hwork(*)
    integer          :: lwork
    integer          :: info
end subroutine magmaf_cgeqrs_gpu

subroutine magmaf_cgeqrs3_gpu( m, n, nrhs, dA, ldda, tau, dT, dB, lddb, hwork, lwork,  &
        info )
    integer          :: m
    integer          :: n
    integer          :: nrhs
    magma_devptr_t   :: dA
    integer          :: ldda
    complex          :: tau(*)
    magma_devptr_t   :: dT
    magma_devptr_t   :: dB
    integer          :: lddb
    complex          :: hwork(*)
    integer          :: lwork
    integer          :: info
end subroutine magmaf_cgeqrs3_gpu

subroutine magmaf_cgerbt_gpu( gen, n, nrhs, dA, ldda, dB, lddb, U, V, info )
    character        :: gen
    integer          :: n
    integer          :: nrhs
    magma_devptr_t   :: dA
    integer          :: ldda
    magma_devptr_t   :: dB
    integer          :: lddb
    complex          :: U(*)
    complex          :: V(*)
    integer          :: info
end subroutine magmaf_cgerbt_gpu

subroutine magmaf_cgessm_gpu( order, m, n, k, ib, ipiv, dL1, lddl1, dL, lddl, dA, ldda,  &
        info )
    character        :: order
    integer          :: m
    integer          :: n
    integer          :: k
    integer          :: ib
    integer          :: ipiv(*)
    magma_devptr_t   :: dL1
    integer          :: lddl1
    magma_devptr_t   :: dL
    integer          :: lddl
    magma_devptr_t   :: dA
    integer          :: ldda
    integer          :: info
end subroutine magmaf_cgessm_gpu

subroutine magmaf_cgesv_gpu( n, nrhs, dA, ldda, ipiv, dB, lddb, info )
    integer          :: n
    integer          :: nrhs
    magma_devptr_t   :: dA
    integer          :: ldda
    integer          :: ipiv(*)
    magma_devptr_t   :: dB
    integer          :: lddb
    integer          :: info
end subroutine magmaf_cgesv_gpu

subroutine magmaf_cgesv_nopiv_gpu( n, nrhs, dA, ldda, dB, lddb, info )
    integer          :: n
    integer          :: nrhs
    magma_devptr_t   :: dA
    integer          :: ldda
    magma_devptr_t   :: dB
    integer          :: lddb
    integer          :: info
end subroutine magmaf_cgesv_nopiv_gpu

subroutine magmaf_cgetf2_gpu( m, n, dA, ldda, ipiv, info )
    integer          :: m
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    integer          :: ipiv(*)
    integer          :: info
end subroutine magmaf_cgetf2_gpu

subroutine magmaf_cgetrf_gpu( m, n, dA, ldda, ipiv, info )
    integer          :: m
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    integer          :: ipiv(*)
    integer          :: info
end subroutine magmaf_cgetrf_gpu

subroutine magmaf_cgetrf_nopiv_gpu( m, n, dA, ldda, info )
    integer          :: m
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    integer          :: info
end subroutine magmaf_cgetrf_nopiv_gpu

subroutine magmaf_cgetri_gpu( n, dA, ldda, ipiv, dwork, lwork, info )
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    integer          :: ipiv(*)
    magma_devptr_t   :: dwork
    integer          :: lwork
    integer          :: info
end subroutine magmaf_cgetri_gpu

subroutine magmaf_cgetrs_gpu( trans, n, nrhs, dA, ldda, ipiv, dB, lddb, info )
    character        :: trans
    integer          :: n
    integer          :: nrhs
    magma_devptr_t   :: dA
    integer          :: ldda
    integer          :: ipiv(*)
    magma_devptr_t   :: dB
    integer          :: lddb
    integer          :: info
end subroutine magmaf_cgetrs_gpu

subroutine magmaf_cgetrs_nopiv_gpu( trans, n, nrhs, dA, ldda, dB, lddb, info )
    character        :: trans
    integer          :: n
    integer          :: nrhs
    magma_devptr_t   :: dA
    integer          :: ldda
    magma_devptr_t   :: dB
    integer          :: lddb
    integer          :: info
end subroutine magmaf_cgetrs_nopiv_gpu

subroutine magmaf_cheevd_gpu( jobz, uplo, n, dA, ldda, w, wA, ldwa, work, lwork, rwork,  &
        lrwork, iwork, liwork, info )
    character        :: jobz
    character        :: uplo
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    real             :: w(*)
    complex          :: wA(*)
    integer          :: ldwa
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: lrwork
    integer          :: iwork(*)
    integer          :: liwork
    integer          :: info
end subroutine magmaf_cheevd_gpu

subroutine magmaf_cheevdx_gpu( jobz, range, uplo, n, dA, ldda, vl, vu, il, iu, m, w, wA,  &
        ldwa, work, lwork, rwork, lrwork, iwork, liwork, info )
    character        :: jobz
    character        :: range
    character        :: uplo
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    real             :: vl
    real             :: vu
    integer          :: il
    integer          :: iu
    integer          :: m
    real             :: w(*)
    complex          :: wA(*)
    integer          :: ldwa
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: lrwork
    integer          :: iwork(*)
    integer          :: liwork
    integer          :: info
end subroutine magmaf_cheevdx_gpu

subroutine magmaf_cheevr_gpu( jobz, range, uplo, n, dA, ldda, vl, vu, il, iu, abstol, m,  &
        w, dZ, lddz, isuppz, wA, ldwa, wZ, ldwz, work, lwork, rwork, lrwork, iwork,  &
        liwork, info )
    character        :: jobz
    character        :: range
    character        :: uplo
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    real             :: vl
    real             :: vu
    integer          :: il
    integer          :: iu
    real             :: abstol
    integer          :: m
    real             :: w(*)
    magma_devptr_t   :: dZ
    integer          :: lddz
    integer          :: isuppz(*)
    complex          :: wA(*)
    integer          :: ldwa
    complex          :: wZ(*)
    integer          :: ldwz
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: lrwork
    integer          :: iwork(*)
    integer          :: liwork
    integer          :: info
end subroutine magmaf_cheevr_gpu

subroutine magmaf_cheevx_gpu( jobz, range, uplo, n, dA, ldda, vl, vu, il, iu, abstol, m,  &
        w, dZ, lddz, wA, ldwa, wZ, ldwz, work, lwork, rwork, iwork, ifail, info )
    character        :: jobz
    character        :: range
    character        :: uplo
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    real             :: vl
    real             :: vu
    integer          :: il
    integer          :: iu
    real             :: abstol
    integer          :: m
    real             :: w(*)
    magma_devptr_t   :: dZ
    integer          :: lddz
    complex          :: wA(*)
    integer          :: ldwa
    complex          :: wZ(*)
    integer          :: ldwz
    complex          :: work(*)
    integer          :: lwork
    real             :: rwork(*)
    integer          :: iwork(*)
    integer          :: ifail(*)
    integer          :: info
end subroutine magmaf_cheevx_gpu

subroutine magmaf_chegst_gpu( itype, uplo, n, dA, ldda, dB, lddb, info )
    integer          :: itype
    character        :: uplo
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    magma_devptr_t   :: dB
    integer          :: lddb
    integer          :: info
end subroutine magmaf_chegst_gpu

subroutine magmaf_chetrd_gpu( uplo, n, dA, ldda, d, e, tau, wA, ldwa, work, lwork, info )
    character        :: uplo
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    real             :: d(*)
    real             :: e(*)
    complex          :: tau(*)
    complex          :: wA(*)
    integer          :: ldwa
    complex          :: work(*)
    integer          :: lwork
    integer          :: info
end subroutine magmaf_chetrd_gpu

subroutine magmaf_chetrd2_gpu( uplo, n, dA, ldda, d, e, tau, wA, ldwa, work, lwork,  &
        dwork, ldwork, info )
    character        :: uplo
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    real             :: d(*)
    real             :: e(*)
    complex          :: tau(*)
    complex          :: wA(*)
    integer          :: ldwa
    complex          :: work(*)
    integer          :: lwork
    magma_devptr_t   :: dwork
    integer          :: ldwork
    integer          :: info
end subroutine magmaf_chetrd2_gpu

subroutine magmaf_chetrf_nopiv_gpu( uplo, n, da, ldda, info )
    character        :: uplo
    integer          :: n
    magma_devptr_t   :: da
    integer          :: ldda
    integer          :: info
end subroutine magmaf_chetrf_nopiv_gpu

subroutine magmaf_clarf_gpu( m, n, dv, dtau, dC, lddc )
    integer          :: m
    integer          :: n
    magma_devptr_t   :: dv
    magma_devptr_t   :: dtau
    magma_devptr_t   :: dC
    integer          :: lddc
end subroutine magmaf_clarf_gpu

subroutine magmaf_clarfb_gpu( side, trans, direct, storev, m, n, k, dV, lddv, dT, lddt,  &
        dC, lddc, dwork, ldwork )
    character        :: side
    character        :: trans
    character        :: direct
    character        :: storev
    integer          :: m
    integer          :: n
    integer          :: k
    magma_devptr_t   :: dV
    integer          :: lddv
    magma_devptr_t   :: dT
    integer          :: lddt
    magma_devptr_t   :: dC
    integer          :: lddc
    magma_devptr_t   :: dwork
    integer          :: ldwork
end subroutine magmaf_clarfb_gpu

subroutine magmaf_clarfb_gpu_gemm( side, trans, direct, storev, m, n, k, dV, lddv, dT,  &
        lddt, dC, lddc, dwork, ldwork, dworkvt, ldworkvt )
    character        :: side
    character        :: trans
    character        :: direct
    character        :: storev
    integer          :: m
    integer          :: n
    integer          :: k
    magma_devptr_t   :: dV
    integer          :: lddv
    magma_devptr_t   :: dT
    integer          :: lddt
    magma_devptr_t   :: dC
    integer          :: lddc
    magma_devptr_t   :: dwork
    integer          :: ldwork
    magma_devptr_t   :: dworkvt
    integer          :: ldworkvt
end subroutine magmaf_clarfb_gpu_gemm

subroutine magmaf_clarfb2_gpu( m, n, k, dV, lddv, dT, lddt, dC, lddc, dwork, ldwork )
    integer          :: m
    integer          :: n
    integer          :: k
    magma_devptr_t   :: dV
    integer          :: lddv
    magma_devptr_t   :: dT
    integer          :: lddt
    magma_devptr_t   :: dC
    integer          :: lddc
    magma_devptr_t   :: dwork
    integer          :: ldwork
end subroutine magmaf_clarfb2_gpu

subroutine magmaf_clauum_gpu( uplo, n, dA, ldda, info )
    character        :: uplo
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    integer          :: info
end subroutine magmaf_clauum_gpu

subroutine magmaf_cposv_gpu( uplo, n, nrhs, dA, ldda, dB, lddb, info )
    character        :: uplo
    integer          :: n
    integer          :: nrhs
    magma_devptr_t   :: dA
    integer          :: ldda
    magma_devptr_t   :: dB
    integer          :: lddb
    integer          :: info
end subroutine magmaf_cposv_gpu

subroutine magmaf_cpotf2_gpu( uplo, n, dA, ldda, info )
    character        :: uplo
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    integer          :: info
end subroutine magmaf_cpotf2_gpu

subroutine magmaf_cpotrf_gpu( uplo, n, dA, ldda, info )
    character        :: uplo
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    integer          :: info
end subroutine magmaf_cpotrf_gpu

subroutine magmaf_cpotri_gpu( uplo, n, dA, ldda, info )
    character        :: uplo
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    integer          :: info
end subroutine magmaf_cpotri_gpu

subroutine magmaf_cpotrs_gpu( uplo, n, nrhs, dA, ldda, dB, lddb, info )
    character        :: uplo
    integer          :: n
    integer          :: nrhs
    magma_devptr_t   :: dA
    integer          :: ldda
    magma_devptr_t   :: dB
    integer          :: lddb
    integer          :: info
end subroutine magmaf_cpotrs_gpu

subroutine magmaf_cssssm_gpu( order, m1, n1, m2, n2, k, ib, dA1, ldda1, dA2, ldda2, dL1,  &
        lddl1, dL2, lddl2, ipiv, info )
    character        :: order
    integer          :: m1
    integer          :: n1
    integer          :: m2
    integer          :: n2
    integer          :: k
    integer          :: ib
    magma_devptr_t   :: dA1
    integer          :: ldda1
    magma_devptr_t   :: dA2
    integer          :: ldda2
    magma_devptr_t   :: dL1
    integer          :: lddl1
    magma_devptr_t   :: dL2
    integer          :: lddl2
    integer          :: ipiv(*)
    integer          :: info
end subroutine magmaf_cssssm_gpu

subroutine magmaf_ctrtri_gpu( uplo, diag, n, dA, ldda, info )
    character        :: uplo
    character        :: diag
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    integer          :: info
end subroutine magmaf_ctrtri_gpu

subroutine magmaf_cungqr_gpu( m, n, k, dA, ldda, tau, dT, nb, info )
    integer          :: m
    integer          :: n
    integer          :: k
    magma_devptr_t   :: dA
    integer          :: ldda
    complex          :: tau(*)
    magma_devptr_t   :: dT
    integer          :: nb
    integer          :: info
end subroutine magmaf_cungqr_gpu

subroutine magmaf_cunmql2_gpu( side, trans, m, n, k, dA, ldda, tau, dC, lddc, wA, ldwa,  &
        info )
    character        :: side
    character        :: trans
    integer          :: m
    integer          :: n
    integer          :: k
    magma_devptr_t   :: dA
    integer          :: ldda
    complex          :: tau(*)
    magma_devptr_t   :: dC
    integer          :: lddc
    complex          :: wA(*)
    integer          :: ldwa
    integer          :: info
end subroutine magmaf_cunmql2_gpu

subroutine magmaf_cunmqr_gpu( side, trans, m, n, k, dA, ldda, tau, dC, lddc, hwork,  &
        lwork, dT, nb, info )
    character        :: side
    character        :: trans
    integer          :: m
    integer          :: n
    integer          :: k
    magma_devptr_t   :: dA
    integer          :: ldda
    complex          :: tau(*)
    magma_devptr_t   :: dC
    integer          :: lddc
    complex          :: hwork(*)
    integer          :: lwork
    magma_devptr_t   :: dT
    integer          :: nb
    integer          :: info
end subroutine magmaf_cunmqr_gpu

subroutine magmaf_cunmqr2_gpu( side, trans, m, n, k, dA, ldda, tau, dC, lddc, wA, ldwa,  &
        info )
    character        :: side
    character        :: trans
    integer          :: m
    integer          :: n
    integer          :: k
    magma_devptr_t   :: dA
    integer          :: ldda
    complex          :: tau(*)
    magma_devptr_t   :: dC
    integer          :: lddc
    complex          :: wA(*)
    integer          :: ldwa
    integer          :: info
end subroutine magmaf_cunmqr2_gpu

subroutine magmaf_cunmtr_gpu( side, uplo, trans, m, n, dA, ldda, tau, dC, lddc, wA, ldwa,  &
        info )
    character        :: side
    character        :: uplo
    character        :: trans
    integer          :: m
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    complex          :: tau(*)
    magma_devptr_t   :: dC
    integer          :: lddc
    complex          :: wA(*)
    integer          :: ldwa
    integer          :: info
end subroutine magmaf_cunmtr_gpu

subroutine magmaf_cnan_inf( uplo, m, n, A, lda, cnt_nan, cnt_inf )
    character        :: uplo
    integer          :: m
    integer          :: n
    complex          :: A(*)
    integer          :: lda
    integer          :: cnt_nan(*)
    integer          :: cnt_inf(*)
end subroutine magmaf_cnan_inf

subroutine magmaf_cnan_inf_gpu( uplo, m, n, dA, ldda, cnt_nan, cnt_inf )
    character        :: uplo
    integer          :: m
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
    integer          :: cnt_nan(*)
    integer          :: cnt_inf(*)
end subroutine magmaf_cnan_inf_gpu

subroutine magmaf_cprint( m, n, A, lda )
    integer          :: m
    integer          :: n
    complex          :: A(*)
    integer          :: lda
end subroutine magmaf_cprint

subroutine magmaf_cprint_gpu( m, n, dA, ldda )
    integer          :: m
    integer          :: n
    magma_devptr_t   :: dA
    integer          :: ldda
end subroutine magmaf_cprint_gpu

end interface

!---- Fortran-only subroutines (see ../tools/fortran_wrappers.pl to edit) ----
contains

subroutine magmaf_coff1d( ptrNew, ptrOld, inc, i)
    magma_devptr_t   :: ptrNew
    magma_devptr_t   :: ptrOld
    integer          :: inc, i

    ptrNew = ptrOld + (i-1) * inc * sizeof_complex
end subroutine magmaf_coff1d

subroutine magmaf_coff2d( ptrNew, ptrOld, lda, i, j)
    magma_devptr_t   :: ptrNew
    magma_devptr_t   :: ptrOld
    integer          :: lda, i, j

    ptrNew = ptrOld + ((j-1) * lda + (i-1)) * sizeof_complex
end subroutine magmaf_coff2d

end module magma_cfortran


C
C	$Id: g01iws.f,v 1.5 2008-07-27 00:21:05 haley Exp $
C
C                Copyright (C)  2000
C        University Corporation for Atmospheric Research
C                All Rights Reserved
C
C The use of this Software is governed by a License Agreement.
C
      SUBROUTINE G01IWS
C
C  Initialization of constants.
C
C  Initialize workstation state list and other internal constants
C  as required upon open workstation.
C
      include 'g01prm.h'
      include 'g01wsl.h'
      include 'g01ins.h'
      include 'gksenu.h'
C
C  Internal constants.
C
C  MIN and MAX VDC address limits in x and y directions, the VDC extent.
C
      MINXVD = 0
      MAXXVD = 32767
      MINYVD = 0
      MAXYVD = 32767
C
C  NDC to VDC mapping coefficients, X and Y directions.
C
      MXOFF = 0
      MXSCAL = 32767
      MYOFF = 0
      MYSCAL = 32767
C
C  Color table change, background color change.
C
      MCTCHG = GNO
      MBCCHG = GNO
C
C  WSL items.
C
C  State is inactive (0=GINACT)
C
      MSTATE = GINACT
C
C  Deferral mode is ASTI (3=GASTI)
C
      MDEFMO = 3
C
C  Implicit regeneration mode is allowed (1=GALLOW)
C
      MREGMO = 1
C
C  Display surface is empty (1=GEMPTY)
C
      MDEMPT = GEMPTY
C
C  New frame necessary at update is NO (0=GNO)
C
      MNFRAM = GNO
C
C  Workstation transformation update state is NOT PENDING (0=GNPEND)
C
      MTUS = GNPEND
C
C  Requested workstation window in NDC is unit square.
C
      RWINDO(1) = 0.0
      RWINDO(2) = 1.0
      RWINDO(3) = 0.0
      RWINDO(4) = 1.0
C
C  Current workstation window in NDC is unit square.
C
      CWINDO(1) = 0.0
      CWINDO(2) = 1.0
      CWINDO(3) = 0.0
      CWINDO(4) = 1.0
C
C  Requested workstation viewport is real metafile address space.
C
      RWKVP(1) = 0.
      RWKVP(2) = 32767.
      RWKVP(3) = 0.
      RWKVP(4) = 32767.
C
C  Current workstation viewport is metafile address space.
C
      CWKVP(1) = 0.
      CWKVP(2) = 32767.
      CWKVP(3) = 0.
      CWKVP(4) = 32767.
C
C  Color indices are sorted by default.
C
      MCSORT = 1
C
C  Number of currently defined color indices is 0.
C
      MOL = 0
C
C  Overflow flag for color index arrays is NO (0=GNO).
C
      MCOVFL = GNO
C
C  WSL clipping control parameters.
C
C  Clipping indicator is ON (1=GCLIP)
C
      MRCLIP = GCLIP
C
C  Clipping rectangle is metafile address space, corner-point form.
C
      MRCREC(1) = MINXVD
      MRCREC(2) = MINYVD
      MRCREC(3) = MAXXVD
      MRCREC(4) = MAXYVD
C
      RETURN
      END


!!  Copyright (C)  Stichting Deltares, 2012-2016.
!!
!!  This program is free software: you can redistribute it and/or modify
!!  it under the terms of the GNU General Public License version 3,
!!  as published by the Free Software Foundation.
!!
!!  This program is distributed in the hope that it will be useful,
!!  but WITHOUT ANY WARRANTY; without even the implied warranty of
!!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
!!  GNU General Public License for more details.
!!
!!  You should have received a copy of the GNU General Public License
!!  along with this program. If not, see <http://www.gnu.org/licenses/>.
!!
!!  contact: delft3d.support@deltares.nl
!!  Stichting Deltares
!!  P.O. Box 177
!!  2600 MH Delft, The Netherlands
!!
!!  All indications and logos of, and references to registered trademarks
!!  of Stichting Deltares remain the property of Stichting Deltares. All
!!  rights reserved.

      subroutine bacmrt ( pmsa   , fl     , ipoint , increm , noseg  ,
     &                    noflux , iexpnt , iknmrk , noq1   , noq2   ,
     &                    noq3   , noq4   )
!>\file
!>       Mortality of bacteria depending on UV-light, salinity and temperature

!
!     Description of the module :
!
!        General water quality module for DELWAQ:
!        GENERAL ROUTINE FOR THE MORTALITY OF BACTERIA: A FIRST ORDER APPROACH
!        WITH A USER DEFINED RATE CONSTANT CORRECTED FOR TEMPERATURE AND
!        SALINITY. THE MORTALITY RATE IS HIGHTENED BY A LIGHT DEPENDANT PART
!        CONCENTRATION OF BACTERIA EXPRESSED IN SOMETHING/M3
!
! Name    T   L I/O   Description                                   Units
! ----    --- -  -    -------------------                            ----
! BACT    R*4 1 I concentration bacteria                              [gX]
! CFRAD   R*4 1 I conversion factor RAD->mortality                    [m2/W/d]
! CRTEMP  R*4 1 I critical temperature for mortality                      [xC]
! MORT    R*4 1 L overall first order mortality rate                     [1/d]
! MRTRAD  R*4 1 O part of firt order mortality rate from RAD             [1/d]
! DEPTH   R*4 1 I water depth                                          [m]
! EXTUV   R*4 1 I extinction of UV radiation                         [1/m]
! FL (1)  R*4 1 O mortality flux                                      [X/m3/d]
! RAD     R*4 1 I solar radiation at surface (daily averge)         [W/m2]
! RCMRT   R*4 1 I user defined first order mortality rate                [1/d]
! TEMP    R*4 1 I ambient temperature                                 [xC]
! TEMP20  R*4 1 L ambient temperature - stand. temp (20)              [xC]
! TEMPF   R*4 1 L temperature function                                 [-]
! TCMRT   R*4 1 I temperature coefficient for mortality                  [1/d]
! VOLUME  R*4 1 L DELWAQ volume                                       [m3]
! ZOUT    R*4 1 I chloride concentration                            [g/m3]
!     Logical Units : -

!     Modules called : -

!     Name     Type   Library
!     ------   -----  ------------

      IMPLICIT REAL (A-H,J-Z)

      REAL     PMSA  ( * ) , FL    (*)
      INTEGER  IPOINT( * ) , INCREM(*) , NOSEG , NOFLUX,
     +         IEXPNT(4,*) , IKNMRK(*) , NOQ1, NOQ2, NOQ3, NOQ4

      IP1  = IPOINT( 1)
      IP2  = IPOINT( 2)
      IP3  = IPOINT( 3)
      IP4  = IPOINT( 4)
      IP5  = IPOINT( 5)
      IP6  = IPOINT( 6)
      IP7  = IPOINT( 7)
      IP8  = IPOINT( 8)
      IP9  = IPOINT( 9)
      IP10 = IPOINT(10)
      IP11 = IPOINT(11)
      IP12 = IPOINT(12)
      IP13 = IPOINT(13)
      IP14 = IPOINT(14)
      IP15 = IPOINT(15)
!
      IFLUX = 0
      DO 9000 ISEG = 1 , NOSEG
!!    CALL DHKMRK(1,IKNMRK(ISEG),IKMRK1)
!!    IF (IKMRK1.EQ.1) THEN
      IF (BTEST(IKNMRK(ISEG),0)) THEN
!
      BACT   = PMSA( IP1 )
      RCMRT  = PMSA( IP2 )
      TCMRT  = PMSA( IP3 )
      TEMP   = PMSA( IP4 )
      CRTEMP = PMSA( IP5 )
      ZOUT   = PMSA( IP6 )
      RAD    = PMSA( IP7 )
      CFRAD  = PMSA( IP8 )
      DAYL   = PMSA( IP9 )
      FRUV   = PMSA( IP10)
      EXTUV  = PMSA( IP11)
      DEPTH  = PMSA( IP12)
      SPMRTZ = PMSA( IP13)

      IF (EXTUV .LT. 1E-20 )  CALL ERRSYS ('EXTUV in BACMRT zero', 1 )

!***********************************************************************
!**** Processes connected to the MORTALITY OF BACTERIA
!***********************************************************************
!
!
      IF (TEMP .LE. CRTEMP) THEN
!
!        No mortality at all
!
         FL( 1 + IFLUX ) = 0.0
!
      ELSE
!
!        Calculation of mortality flux ( M.L-3.t-1)
!
         TEMP20 = TEMP - 20.0
         TEMPF  = TCMRT ** TEMP20

!        Calculation of the RAD dependent part of the mortality
         MRTRAD = CFRAD*RAD*FRUV*DAYL*(1 - EXP(-EXTUV * DEPTH) )
     &                        / (EXTUV * DEPTH )

!        Calculation of the overall mortality
!        MORT  = ( RCMRT + 1.1*1E-5 * ZOUT ) * TEMPF + MRTRAD
         MORT  = ( RCMRT + SPMRTZ * ZOUT ) * TEMPF + MRTRAD
!
         FL ( 1 + IFLUX  ) = MORT * BACT
!
      ENDIF

      PMSA (IP14 ) = MORT
      PMSA (IP15 ) = MRTRAD
!
      ENDIF
      IFLUX = IFLUX + NOFLUX
      IP1   = IP1   + INCREM (  1 )
      IP2   = IP2   + INCREM (  2 )
      IP3   = IP3   + INCREM (  3 )
      IP4   = IP4   + INCREM (  4 )
      IP5   = IP5   + INCREM (  5 )
      IP6   = IP6   + INCREM (  6 )
      IP7   = IP7   + INCREM (  7 )
      IP8   = IP8   + INCREM (  8 )
      IP9   = IP9   + INCREM (  9 )
      IP10  = IP10  + INCREM ( 10 )
      IP11  = IP11  + INCREM ( 11 )
      IP12  = IP12  + INCREM ( 12 )
      IP13  = IP13  + INCREM ( 13 )
      IP14  = IP14  + INCREM ( 14 )
      IP15  = IP15  + INCREM ( 15 )
!
 9000 CONTINUE
!
      RETURN
!
      END


! Copyright (c) 2019, Arm Ltd.  All rights reserved.
!
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
!     http://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.

subroutine s1 ! error
  implicit none
  integer :: x(10)
  real :: results
  integer :: i

  do i=1,10
    x(i) = i
  enddo
  !{error "PGF90-S-0074-Illegal number or type of arguments to norm2 - keyword argument x"}
  results = norm2(x)
end

subroutine s2 ! error
  implicit none
  real :: y(10)
  real :: results
  integer :: i
  do i=1,10
    y(i)=i
  end do
  !{error "PGF90-S-0423-Constant DIM= argument is out of range"}
  results = norm2(y, 2)
end

subroutine s3
  implicit none
  real :: z(10)
  real :: results
  integer :: i
  do i=1,10
    z(i)=i
  end do
  !{error "PGF90-S-0074-Illegal number or type of arguments to norm2 - keyword argument position 3"}
  results = norm2(z, 1, 0)
end

subroutine s4
  implicit none
  real :: z(10)
  real :: results
  integer :: i
  do i=1,10
    z(i)=i
  end do
  !{error "PGF90-S-0074-Illegal number or type of arguments to norm2 - 0 argument(s) present, 1-3 argument(s) expected"}
  results = norm2()
end

subroutine s5
  implicit none
  !{error "PGF90-S-0155-Intrinsic not supported in initialization: norm2"}
  real :: results = norm2([real :: 2, 3, 4, 5])
end

  call s1
  call s2
  call s3
  call s4
  call s4
  call s5
end


      Subroutine FKMIEX(ibuf,buf,lbuf,scr,scr2,scr3)
!-------------------------------------------------------------------------------
!      FKMIEX is the execution phase of the sioseis process fkmigr. FKMIEX
! performs the Stolt FK migration.  The input data to FKMIEX must be in the FK
! domain (i.e. must have been through process TX2FK).
!
!      FKMIEX is called once for each input k domain complex frequency trace.
! The wavenumbers of the input traces are from 0 to +k Nyquist (The negative
! wavenumbers are not needed since they can be inferred from the positive
! ones). The frequencies of the input trace are from -Nyq -> 0 -> +Nyq.
!
!     FKMIEX basically does some housekeeping for the input traces. The
! main work is done by STOLT for the AP version, and by routine HALE for the
! non AP version.
!
! Known Limitations (10/3/88):
!      The AP version has not been tested.
!
! Inputs:
!    BUF - The complex frequency trace to be migrated
!   IBUF - The integer*2 equivalent of buf. Used to pass trace header info
!   LBUF - The integer*4 equivalent of buf. Used to pass trace header info
!   SCR/ISCR/LSCR/ - Scratch array and its integer equivalents.
!
! Outputs:
!    BUF - contains the migrated trace.
!
! Called from : CONTRO
!
! Externals :
!  PODISC, RDDISC    : Disk i/o routines
!  EXIT
!  INAP
! Non-AP version
!  RECTC, POLARC     : Coordinate conversion routines
!  HALE              : Migration routine
! AP version :
!  VMOV, APPUT, APWD
!  RECT, POLAR       : Coordinate conversion routines
!  STOLT1, STOLT2    : Migration routine
!
! Modifications:
!   10/5/88 Altered the Scratch indices on the call to HALE
!   10/12/88 Corrected Idtype check
!   11/11/88  added DATINAP
!   3/14/89 Changed format so as to read binary data through /READT/
!           and changed txsius to integer
!   24 Jul 01 - Print a message if too much data.  Hale needs 3 complex scratch buffers
!   18 July 07 - Get nwrds from common numdat rather than segy header
!              - Use scr2 and scr3 input trace buffers as scratch buffers.
!   Sep 08 - Use numdat rather than segy header
!-------------------------------------------------------------------------------
!
! INCLUDE FILES
!.. Include file defining constants of use globally throughout SIOSEIS
!
! Define the sizes of some Large common blocks

      integer SZAPMEM, SZTRANP
      parameter (SZAPMEM = 5000000)                                     ! Size of /APMEM/ : AP memory
      parameter (SZTRANP = 262144)                                      ! Size of /TRANP/: Transpose array at 512x512
! parameter definitions for the stop signal istop
      integer STOPNOTR, STOPTR, NOSTOP
      parameter (STOPNOTR  = -1)                                        ! last call but no trace passed
      parameter (STOPTR    =  1)                                        ! last call and a trace passed
      parameter (NOSTOP    =  0)                                        ! normal call to the routine
!
! parameter for AP
      integer CLEARAP, USEAP, NOAP
      integer DATINAP
      parameter (USEAP    = 1)                                          ! There is an AP available
      parameter (NOAP     = 0)                                          ! No AP available
      parameter (CLEARAP  = 0)                                          ! Get data out of AP simulator
      parameter (DATINAP   = 1)                                         ! Data is in the AP
! This include file include all (?) of the parameters needed to define SIOSEIS
! I/O routines. In particular it defines positions of objects in the SEGY
! headers & constants for these values
!
! EBCDIC HEADER
! Declare Header lengths. These are the length of the EXTERNAL disk image in
! host words.
      integer     CRAYEBC, NORMEBC
      parameter ( CRAYEBC  = 400)
      parameter ( NORMEBC  = 2*CRAYEBC)
!
! BINARY HEADER
      integer     CRAYBIN, NORMBIN
      parameter ( CRAYBIN  =  50)                                       ! length of external disk image
      parameter ( NORMBIN  = 2*CRAYBIN)
!
!  The position of objects in the Binary header
      integer    NTRCPTR,IFMTPTR, IDTYPPTR, INKPTR, ITSIPTR
      integer    ITDELPTR
      parameter (NTRCPTR  =  7)                                         ! No of traces / gather
      parameter (IFMTPTR  = 13)                                         ! The SEGY Format of the data
      parameter (IDTYPPTR = 31)                                         ! The Domain/ID of the data e.q. T-X data
      parameter (INKPTR   = 32)                                         ! The No. of wavenumbers in an f-k dataset
      parameter (ITSIPTR  = 33)                                         ! Record of tx sample interval in us
      parameter (ITDELPTR = 34)                                         ! Record of tx time delay in ms.
!
!..Constants for SEGY Format (IFMTPTR)
      integer IBMFP, INT16, INT32, HOSTFP
      parameter (IBMFP  = 1)                                            ! IBM floating point
      parameter (INT32  = 2)
      parameter (INT16  = 3)
      parameter (HOSTFP = 5)                                            ! Host FP. In actuality Host FP >= 5
!
!.. Data Domains/Types (IDTYPPTR)
      integer    IDTX, IDFKRCT, IDFKPLR, IDFKPLRU
      parameter (IDTX     = 1)
      parameter (IDFKRCT  = 2)
      parameter (IDFKPLR  = 3)
      parameter (IDFKPLRU = 8)
!
! TRACE HEADER
!.. Declare header length on external disk files. Internal length is given by
! Numhdr in common block READT.
      integer  CRAYTHDR, NORMTHDR
      parameter ( CRAYTHDR =  30)                                       ! Length of external disk image
      parameter ( NORMTHDR = 2*CRAYTHDR)
!
      common /SEGYPTR/ LLSEQPTR, LRSEQPTR, LSHOTPTR, LSHTRPTR, LRPNPTR,
     *                 LRPTRPTR, ITRIDPTR, LDISTPTR, LWBDPTR,  LSXCOPTR,
     *                 LRXCOPTR, IDELMPTR, ISTMPTR,  IENDMPTR, ISAMPPTR,
     *                 ISIPTR,   IYRPTR,   IDAYPTR,  IHRPTR,   IMINPTR,
     *                 ISECPTR,  IGMTPTR,  LDELSPTR, LSMUSPTR, LEMUSPTR,
     *                 LSISPTR,  LWBTSPTR, LGATPTR,  LSSMSPTR, LESMSPTR,
     *                 LSBPTR
!
!.. Define Constants for Trace Header
!
!.. Constants for Trace ID (ITRIDPTR)
      integer    LIVETR, DEADTR                                         ! Parameters for trace Type
      parameter (LIVETR  = 1)
      parameter (DEADTR  = 2)
!
!.. Define constants for use with the DISKIO subroutines getfil, frefil,
! podisc
! GETFIL constants
      integer    CREATTMP, CREATNEW
      parameter (CREATTMP   = 1)                                        ! Create a temporary file
      parameter (CREATNEW   = 3)                                        ! Create a new named file
! FREFIL constants
      integer    RLDLCLS
      parameter (RLDLCLS = 3)
! PODISC constants
      integer    POSABS, POSREL, DSKSTRT
      parameter (POSABS     = 1)
      parameter (POSREL     = 2)
      parameter (DSKSTRT    = 0)                                        ! The starting position on the disk
! Include file TXFK.INC
! include file for the sioseis 2D FFT and fk migration routines
!
!
! Parameters for coord type
      integer CDRECT, CDPOLAR, CDPOLARU
      parameter ( CDRECT   = 1)
      parameter ( CDPOLAR  = 2)
      parameter ( CDPOLARU = 3)
!
! parameters for Windows
      integer BoxCar
      parameter (BoxCar = 5)
! PROGRAM
      Parameter (NSCLRS = 7)
      Parameter (PI = 3.141592654)
!
      common /SIOAP/ iasgnd,irelse,in,iout,nextad,lapsiz,ifree,iuseap,
     *               idecim
      common /READT/ilun,numhdr,numdat,iunhdr,ireelm,intrcs,ifmt,nskip,
     *               secs,lrenum,isrcf,idtype,
     *               nfskip, jform, itxsi, itxdel, nfktrc
      common /FKMIGR/ v,nfint,lprint,dx,dt, realk
      common /APMEM/ ap(SZAPMEM)
      COMMON /EDITS/ IERROR,IWARN,IRUN,NOW,ICOMPT,isite, maxsamps,nbperw
!
      dimension lbuf(111),buf(111), scr(111), scr2(111), scr3(111)
      integer*2 ibuf(111)
      integer   txsius
      integer   LocCoord
      real      sclrs(NSCLRS)
      logical   first
      save
!
      data first /.true./, nxdone/0/
!
      if (first) then                                                   ! FKMIGR Initialization
        first = .false.
!
!..                       Read the time delay/sample interval from READT common
        txsius = itxsi                                                  ! t-x sample interval in us
        delay  = itxdel/1000.                                           ! & time delay in secs.
!
        if (idtype.eq.IDFKRCT) then
           LocCoord = CDRECT
        else if ((idtype.eq.IDFKPLR).OR.(idtype.eq.IDFKPLRU)) then
           LocCoord = CDPOLAR
        else
          print *, ' *** FKMIGR Error *** ',
     *           ' The input data is not in the FK domain.'
          STOP
        endif
        nv    = 1                                                       ! Only a single velocity allowed
        nx    = 2* (nfktrc-1)                                           ! Calcalate no. of output traces
        if(dt.le.0.)
     *    dt  = FLOAT(txsius)/1.0E6                                     ! Delta t
        dk    = 2.*pi/(float(nx)*dx)                                    ! Delta k (distance between wavenumbers)
!        nwrds = ibuf(ISAMPPTR)                                          ! No. of 32 bit words in the complex trace
!        IF( IAND(ibuf(ISAMPPTR),32768) .NE. 0 ) nwrds = lbuf(29)
        nwrds = numdat
        IF( nwrds .GT. 32768 ) THEN
            PRINT *,' ***  ERROR  ***   Too many samples for FKMIGR.'
            PRINT *,' The maximum number of samples allowed is 16384.'
            STOP
        ENDIF
        nw    = nwrds / 2                                               ! The number of frequencies
        IF( nw .LE. 0 ) THEN
            PRINT *,' ***  ERROR  ***  Bad nw in fkmigr. ',nw
            STOP
        ENDIF
        dw    = 2.*pi/(float(nw)*dt)                                    ! Delta w (distance between frequencies)
        to    = delay * dw                                              ! The delay normalized wrt sampling rate
        vnorm = v*v / (4.0*dw*dw)                                       ! (v/2 )** 2  normalized wrt sampling rate
        nt    = nwrds / 2                                               ! No. of time samples
!        IF( nwrds*3 .GT. maxsamps .OR. nwrds .LE. 0 ) THEN
!            PRINT *,' ***  ERROR  ***  Bad number of frequencies of ',
!     &        nwrds,' in FKMIGR.'
!            PRINT *,' Max number of frequencies is ',maxsamps/6,
!c****       remember the data are now complex and HALE needs 3 scratch buffers.
!     &        ' but have ', nw
!            PRINT *,' (Keep the number of times samples < 8192.)'
!c   If maxsamps is 64K, which is 32K complexes,
!            STOP
!        ENDIF
        realk = 0.                                                      ! Wavenumber of the initial input trace
!
        if( iuseap .eq. USEAP) then                                     ! AP specific initialization
          sclrs(1) =  0.00001
          sclrs(2) =  0.99999
          sclrs(3) =  nfint/2-1
          sclrs(4) = -nw/2
          sclrs(5) = -nw-2
          sclrs(6) =  nw
          sclrs(7) =  to
!
!..                                 Set up the AP addresses - use all of the AP
          iastrt   = 0
          iavsks   = iastrt
          iap      = iavsks + nv
          iaq      = iap + nwrds
          iasclr   = iaq + nv*nwrds                                     ! Put scalars after q, which is nwrds long
          iaspac   = iasclr + NSCLRS                                    ! Scratch area after scalars (nsclrs long)
          iaend    = iaspac + nwrds + nw*13 + 4 + NSCLRS-1              ! Last AP address
!
!..                                                                     ! Put the trace in the ap and make sure it fits
          call inap(buf(numhdr+1),nwrds)
          if(nextad-in.ne.nwrds/idecim*2) then                          ! Assume inap allocates 2 traces
            print *,' ***  FKMIGR WARNING  *** ',
     *        'Some previous AP process is going to be overwriten',
     *        ' Eliminate the pre FKMIGR AP process.'
          endif
          if(iaend.ge.lapsiz) then
            print 120,iaend,lapsiz
  120       format(' ***  FKMIGR ERROR  ***',
     *             ' Too much AP is requested.',I6,
     *              'requested, Max allowed is',I6)
          endif
        endif                                                           ! of AP specific initialization
      endif                                                             ! of FKMIEX initialization
!
!***********************                                ***********************
!*                          Start of trace migration
!***********************                                ***********************
!
      call inap(buf(numhdr+1),nwrds)                                    ! Assume inap puts it at ap location 1
      vskso4 = vnorm * realk * realk                                    ! ( (v * k)/(2 * dw) ) ** 2
!
!..                                           AP version of migration
      if( iuseap .eq. USEAP ) then
        if ( LocCoord.eq.CDPOLAR ) then
           call vmov(in,1,nextad,2,nw)                                  ! Move the polar coords in pairs
           call vmov(in+nw,1,nextad+1,2,nw)                             ! Move the phase spectrum
           call rect(nextad,2,in,2,nw)                                  ! Convert to rectangular coords
        endif
        call apput(sclrs,iasclr,NSCLRS,2)                               ! Put the scalars in the AP each time
        call apput(vskso4,iavsks,nv,2)
        if( IAND(lprint,2).eq.2 ) then
          print '(/A)', 'Debug Info FKMIGR: AP version'
          print 530, vskso4, nv, nfint, nt, nw
  530     format ( '(v*k)/(2*dw)**2: ',f10.4,'No. velocities (nv)'
     *            ,I3,' nfint ', I4,' Time points (nt)', I6,
     *            ' No. of wavelegths (nw): ',I5)
!           call dumpap(iasclr,7)
        endif
!
        call apwd
!        call stolt1(iavsks,nv,iap,iaq,nt,nw,nfint,iasclr,iaspac)
!        call stolt2(iavsks,nv,iap,iaq,nt,nw,nfint,iasclr,iaspac)
!
        if ( LocCoord.eq.CDRECT) then
          call vmov(iaq,1,in,1,nwrds)                                   ! Move data to where SIOSEIS expects it
        else
          call polar(iaq,2,iasclr,2,nw)
          call vmov(iasclr,2,in,1,nw)
          call vmov(iasclr+1,2,in+nw,1,nw)
        endif
      endif                                                             ! of AP version of migration
!
!..                                  Host memory (Non-AP) version of migration
      if ( iuseap.eq.NOAP ) then
        if ( LocCoord.eq.CDPOLAR ) then
          call rectc( nw, scr, ap(in), ap(in+nw) )                      ! Convert to rect coords
          do 1010 j = 1, nwrds, 2
            ap(in+j-1) = scr(j)
            ap(in+j)   = scr(j+1)
 1010     continue
        endif
!
        if ( IAND(lprint,2).eq.2) then
          print '(/A)','Debug Info FKMIGR: Host memory version '
          print *,'Trace No: ', nxdone,' Wavenumber: ', realk
          print *,'No of w (nw): ', nw,' No of ranges (nx): ', nx,
     *            ' (v*k)/(2*dw)**2 (vkso4): ',vskso4
          print *,'AP address In: ', in, ' Nextad: ', nextad
          print *,'Delay: ', delay,' nwrds=',nwrds
        endif
!
!****   scr(nwrds+nwrds+5) is the start.  nwrds+nwrds+nwrds is needed!
        call HALE(vskso4, ap(in), ap(nextad), nw, nfint, scr, scr,
!     *          scr(nwrds+3), scr(nwrds+nwrds+5), to)
     *          scr2, scr3, to)
!
        if ( LocCoord.eq.CDRECT) then
          do i  = 1, nwrds                                         ! Shift address of migrated trace
 1040       ap(in+i-1) = ap(nextad+i-1)
          enddo
        else if ( LocCoord.eq.CDPOLAR ) then
          call polarc(nw,ap(nextad),scr(1),scr(nw+1))
          do 1050 i=1,nw
            ap(in+i-1)    = scr(i)
            ap(in+nw+i-1) = scr(nw+i)
 1050     continue
        endif
      endif                                                             ! of Non-AP version of migration
!
      realk  = realk  + dk                                              ! Increment the wavenumber
      nxdone = nxdone + 1                                               ! & the number of traces completed
      RETURN
      end


      double complex
     & J34x0,J34x1(4),J34x3(4,4,4),
     & J61x0,J61x1(4),J61x3(4,4,4),J61x5(4,4,4,4,4),
     & J52x0,J52x1(4),J52x2(4,4),J52x3(4,4,4),
     & J52x4(4,4,4,4),J52x5(4,4,4,4,4)

      common/current/J34x0,J34x1,J34x3,
     & J61x0,J61x1,J61x3,J61x5,
     & J52x0,J52x1,J52x2,J52x3,J52x4,J52x5
!$omp threadprivate(/current/)


C
      SUBROUTINE ABSKO(NEWT,NT,TSKAL,PESKAL,ISETA,J,ABSK,SPRID)
C
C        THE ROUTINE ADMINISTERS THE COMPUTATION OF ABSORPTION
C        COEFFICIENTS. IT CALLS THE ROUTINES, GIVING THE PROPER THERMO-
C        DYNAMIC INFORMATION ( J O N ) , THE DETAILS OF THE ABSORPTION
C        MECHANISMS ( D E T A B S ) AND THE FACTORS FOR THE INTERPOLATION
C        IN T  ( T A B S ) . IT CHOOSES (IF NECESSARY READS) THE RIGHT SET
C        OF ABSORPTION-COEFFICIENT DATA (ISETA), STATEMENT NO. 5 AND MAKES
C        THE INTERPOLATION IN T, STATEMENTS NOS. 10-18, AND THE SUMMATION
C        OF A ROSSELAND MEAN, IF INDICATED BY J = 0, STATEMENTS NOS. 25-28
C
C        NEWT SHOULD BE GT 1 THE FIRST TIME THIS ROUTINE IS USED,
C                       EQ 1 WHEN A NEW SET OF T-PE IS USED,
C                       EQ 0 OTHERWISE.
C
C        NT IS THE NUMBER OF T-PE POINTS. THE TEMPERATURES T SHOULD BE EX-
C        PRESSED IN KELVIN, THE ELECTRON PRESSURES PE IN DYNES PER CM2
C        ISETA IS THE WAVELENGTH-SET NUMBER, J THE WAVELENGTH NUMBER IN THAT
C        SET. J EQUAL TO ZERO INDICATES THAT A ROSSELAND MEAN IS WANTED.
C        THIS MEAN IS COMPUTED USING THE WAVELENGTH POINTS OF THE ACTUAL
C        SET (ISETA) AND THE QUADRATURE WEIGHTS GIVEN IN ROSW.
C        IN ABSK AND SPRID THE ABSORPTION AND SCATTERING COEFFICIENTS PER GRAM
C        OF STELLAR MATTER ARE STORED.
C
C        DIMENSIONS NECESSARY
C        AB(NKOMP),ABSK(1),FAKT(NKOMP),FAKTP(IFADIM),NTPO(NTO),PE(NT),PESKAL(1),
C        ROSW(MAX(NL)),SPRID(1),SUMW(NT),T(NT),TSKAL(1),XLA(MAX(NL)),
C        XLA3(MAX(NL))
C        THE DIMENSIONS ARE LOWER LIMITS.
C        DIMENSIONS OF ARRAYS IN COMMONS /CA2/,/CA3/ AND /CFIL/ ARE COMMENTED
C        ON IN SUBROUTINE INABS, THOSE OF ARRAYS IN COMMON /CA4/ IN SUBROUTINE
C        TABS.
C        NKOMP IS THE NUMBER OF 'COMPONENTS'
C        NL(I) IS THE NUMBER OF WAVELENGTHS IN WAVELENGTH SET I
C        NT IS THE NUMBER OF T-PE POINTS SUPPLIED IN TSKAL AND PESKAL
C        NTO IS THE NUMBER OF POINTS IN THOSE SCALES FOR WHICH A DETAILED
C              PRINT-OUT IS WANTED.
      implicit none
      include 'spectrum.inc'
      include 'tsuji.par'
C
      integer newt,iseta,isetp,nt,ifak,kfak,jp,kp,ntp,ioutr,j,komp
      integer ireadp,nabkof,nkompl,j1,j2,iu,position,nop,np,lunit
      real pg,dum,delsum

      logical first
      real TSKAL(NDP),PESKAL(NDP),ABSK(NDP),SPRID(NDP)
      real FAKTP(ifadim)
      real SUMW(NDP)
      real tioabs(ndp),h2oabs(ndp)
      integer iread, iwrit
      COMMON/UTPUT/IREAD,IWRIT
      real abkof
      integer kompla,kompr,komps,nkomp
      COMMON/CA2/ABKOF(nabdim),KOMPLA(mkomp*20),KOMPR,KOMPS,NKOMP
      integer ilogta,null
      COMMON/CA3/ILOGTA(mkomp),NULL
      real afak
      integer nofak,nplats
      COMMON/CA4/AFAK(KFADIM),NOFAK(IFADIM),NPLATS(IFADIM)
      real ab,fakt,pe,t,xla,xla3,ro,sumabs,sumsca,viktr
      integer iset,nlb
      COMMON/CA5/AB(mkomp),FAKT(mkomp),PE(NDP),T(NDP),XLA(20),XLA3(20),
     &           RO,
     &           SUMABS,SUMSCA,VIKTR,ISET,NLB
      integer ireset,islask,ireat
      COMMON/CFIL/IRESET(numbset),ISLASK,IREAT
      integer nto,ntpo
      COMMON/COUTR/NTO,NTPO(10)
      real rosw
      COMMON/CROS/ROSW(20)
      real f1p,f3p,f4p,f5p,hnic,presmo
      COMMON /CARC3/ F1P,F3P,F4P,F5P,HNIC,PRESMO(30)
      real prov
      integer nprova,nprovs,nprov
      COMMON /CARC4/ PROV(mkomp),NPROVA,NPROVS,NPROV
      real ptio,rosav,poxg1
      COMMON /TIO/PTIO(NDP),ROsav(NDP),POXG1(NDP)
      integer ielem,ion
      real tmolim,molh
      COMMON/CI4/ IELEM(16),ION(16,5),TMOLIM,MOLH
      real eh,fe,fh,fhe,fc,fce,fn,fne,fo,foe,fk,fke,fs,fse
      COMMON/CMOL1/EH,FE,FH,FHE,FC,FCE,FN,FNE,FO,FOE,FK,FKE,FS,FSE
      real rotest,prh2o
      COMMON /DENSTY/ ROTEST(NDP),PRH2O(NDP)

      doubleprecision partryck,xmettryck,xiontryck
      character*20 nametryck
      common/fullequilibrium/partryck(ndp,maxmol),
     &       xmettryck(ndp,maxmet),xiontryck(ndp,maxmet),
     &       nametryck(maxmol)

      doubleprecision presneutral,presion,presion2,presion3
      common/orderedpress/presneutral(ndp,100),presion(ndp,100),
     &                    presion2(ndp,100),presion3(ndp,100)
      character species*20, comment*100,path*128
      integer i,nline,ioniz,pathlen,NHtbl_unit
      doubleprecision xlambda
      real nh1,ne,nhe1,nhop,opnh
! 150 is the max allowed number of H lines
      doubleprecision hlambda(150)
      real xlo(150),xup(150),gf(150),npop(150)
      real cont,total,dopple
      integer nlo(150),nup(150)
      character*9 lname(150)
      logical contonly,firsth,lineonly
      data contonly /.true./, firsth /.true./, lineonly /.false./
!

      data first/.true./

      save first
C
C
      if (first) then
        newt=2
        first=.false.
      endif
      ISET=ISETA
      IF(NEWT.GT.1)ISETP=-1
      IF(NEWT.EQ.0)GO TO 5
C
C        FACTORS ONLY DEPENDENT ON T-PE
C
      CALL TABS(NT,TSKAL)
      IFAK=1
      KFAK=1
      JP=0
      KP=1
C
C        LOOP OVER THE T-PE POINTS ('THE FIRST NTP-LOOP')
      DO4 NTP=1,NT
      T(NTP)=TSKAL(NTP)
      PE(NTP)=PESKAL(NTP)
C        IS PRINT-OUT WANTED FOR T-PE POINT NO. NTP
      IOUTR=0
      IF(KP.GT.NTO)GO TO 3
      IF(NTP.EQ.NTPO(KP))GO TO 1
      GO TO 3
    1 IOUTR=1
      KP=KP+1
    3 CONTINUE
C
      CALL JON(T(NTP),PE(NTP),1,PG,RO,DUM,IOUTR,ntp)
! save ro for HI absorption calculation
      rosav(ntp)=ro
cc      print*,'absko back from jon, calling detabs'
      CALL DETABS(J,0,NTP,IOUTR)
cc      print*,'absko back from detabs, nkomp, kompr,komps',
cc     &      nkomp,kompr,komps
C
C        WE STORE THE FAKT ARRAY, MADE IN JON-DETABS IN LONGER ARRAYS NAMELY
C                  IN AFAK FOR TEMPERATURE-INDEPENDENT COMPONENTS
C                  IN FAKTP FOR TEMPERATURE-DEPENDENT ONES
      DO2 KOMP=1,KOMPR
      AFAK(KFAK)=FAKT(KOMP)
cc      print*,'absko fakt(',komp,')',fakt(komp)
    2 KFAK=KFAK+1
      DO4 KOMP=KOMPS,NKOMP
      FAKTP(IFAK)=FAKT(KOMP)
cc      print*,'absko fakt(',komp,')',fakt(komp)
      KFAK=KFAK+NOFAK(IFAK)
    4 IFAK=IFAK+1
C        END OF 'THE FIRST NTP-LOOP'
C
C        READING  OF A NEW WAVELENGTH SET IF INDICATED BY ISET
    5 IF(ISET.EQ.ISETP)GO TO 6
      IREADP=IRESET(ISET)
   51 READ(IREADP,END=52)ISETP,NLB,XLA,XLA3,NABKOF,ABKOF,NKOMPL,KOMPLA
      GO TO 5
   52 REWIND IREADP
      GO TO 51
C        ROSSELAND MEAN OR NOT
    6 IF(J.GT.0)GO TO 9
    7 J1=1
      J2=NLB
      DO8 NTP=1,NT
      SUMW(NTP)=0.
    8 ABSK(NTP)=0.
      GO TO 10
    9 J1=J
      J2=J
C
C        INTERPOLATION IN T
C        LOOP OVER ALL THE WAVELENGTHS IN CASE OF ROSSELAND MEAN. THIS
C        LOOP ENDS IN STATEMENT NO. 26
   10 CONTINUE
      DO26 JP=J1,J2
      KFAK=1
      IFAK=1
      KP=1
C
C        LOOP OVER THE T-PE POINTS ('THE SECOND NTP-LOOP')
      DO26 NTP=1,NT
C
C        IS PRINT-OUT WANTED FOR T-PE POINT NO. NTP
      IOUTR=0
      IF(KP.GT.NTO)GO TO 93
      IF(NTP.EQ.NTPO(KP))GO TO 92
      GO TO 93
   92 IOUTR=1
      KP=KP+1
      IF(KP.EQ.2)IOUTR=2
   93 CONTINUE
      IU=JP
C
C        COMPONENTS WITH ABSORPTION COEFFICIENTS INDEPENDENT OF THE
C        TEMPERATURE
C
      DO14 KOMP=1,KOMPR
      IF(KOMPLA(IU).LE.0)GO TO 12
C        THE VECTOR KOMPLA IS DETERMINED IN SUBROUTINE INABS.
C        KOMPLA GREATER THAN ZERO GIVES THE INDEX IN ABKOF, WHERE THE TABLE FOR
C        THIS COMPONENT AND WAVELENGTH BEGINS.
C        KOMPLA LESS THAN OR EQUAL TO ZERO INDICATES THAT THE ACTUAL ABSORPTION
C        COEFFICIENT FOR THIS COMPONENT AND WAVELENGTH IS ZERO, AS FOUND IN SUB-
C        ROUTINE INABS.
C
   11 position=KOMPLA(IU)
      AB(KOMP)=AFAK(KFAK)*ABKOF(position)
      GO TO 13
   12 AB(KOMP)=0.
   13 KFAK=KFAK+1
   14 IU=IU+NLB
C
C        COMPONENTS WITH T-DEPENDENT ABSORPTION COEFFICIENTS
      DO19 KOMP=KOMPS,NKOMP
      NOP=NOFAK(IFAK)
      IF(NOP.EQ.0)GO TO 17
      IF(KOMPLA(IU).LE.0)GO TO 17
   15 position=NPLATS(IFAK)-1+KOMPLA(IU)
C        THE VECTOR NPLATS IS DETERMINED BY SUBROUTINE TABS. IT GIVES THE ARRAY
C        INDEX OF THE TEMPERATURE AT WHICH THE INTERPOLATION IN ABKOF
C        BEGINS. NOFAK, GIVING INFORMATION ON THE T-INTERPOLATION AND
C        POSSIBLY INDICATING THAT AB=0 (NOFAK=0) IS ALSO DETERMINED BY TABS
C
C        INTERPOLATION
      DELSUM=0.
      DO16 NP=1,NOP
      DELSUM=DELSUM+AFAK(KFAK)*ABKOF(position)
      KFAK=KFAK+1
   16 position=position+1
C
C        HAS THE INTERPOLATION BEEN MADE ON THE LOGARITHM
cc      print*,'absko ifak delsum exp?',ifak,delsum,ilogta(komp)
      IF(ILOGTA(KOMP).GT.0)DELSUM=EXP(DELSUM)
cc      print*,'absko ifak delsum ',ifak,komp,delsum
C        MULTIPLICATION BY FACTOR FROM JON-DETABS
cc      print*,'absko fakt        ',ifak,faktp(ifak)
      DELSUM=DELSUM*FAKTP(IFAK)
cc      print*,'absko fakt*delsum ',ifak,faktp(ifak),delsum
      IF(DELSUM.GE.0.)GO TO 162
C      print*,'osabsko.f faktp(',ifak,')= ',faktp(ifak)
C
C        A NEGATIVE INTERPOLATION RESULT
  161 IF(NULL.GT.0)WRITE(IWRIT,200)KOMP,DELSUM,JP,ISET,T(NTP)
  200 FORMAT(4H AB(,I4,11H) NEGATIVE=,E12.4,5X,17HFOR WAVELENGTH NO,I5,
     *5X,6HSET NO,I5,5X,2HT=,F10.4,'  AND THEREFORE PUT =0 ***ABSKO***')
      AB(KOMP)=0.
      GO TO 18
  162 AB(KOMP)=DELSUM
      GO TO 18
   17 AB(KOMP)=0.
      KFAK=KFAK+NOP
   18 IU=IU+NLB
   19 IFAK=IFAK+1
C
C        WE MULTIPLY BY WAVELENGTH-DEPENDENT  FACTORS AND ADD UP. THIS IS
C        DONE IN DETABS.
cc      print*,'absko, calling detabs 2nd time'
      CALL DETABS(J,JP,NTP,IOUTR)
cc      print*,'absko, back from detabs'
!
! Must add HI bf absorption with improved treatment from Barklem&Piskunov
! BPz 03/04-2019
!
      if (firsth) then
!       read file
        lunit=77
        open(lunit,file='DATA/Hlinedata', status='old')
        read(lunit,*) species,ioniz,nline
        read(lunit,*) comment
*        print*,species,ioniz,nline,comment
        if (species(1:6) /= '01.000' .or. ioniz /= 1) then
          print*, 'wrong H line data file!'
          print*,species,ioniz
          stop 'ERROR!'
        endif
c babsma uses air wavelengths, and so does hbop.f, except for Lyman series
c
        if (nline > 150 ) stop 'increase nline dimension in babsma!'
        do i=1,nline
!         oscillator strengths are computed in hbop.f
          read(lunit,*) hlambda(i),nlo(i),nup(i),xlo(i),xup(i),gf(i),
     &                lname(i)
        enddo
        close(lunit)
        firsth=.false.
      endif
*
      ne=pe(ntp)/(t(ntp)*1.38066e-16)
      nh1=sngl(presneutral(ntp,1))/(t(ntp)*1.38066e-16)
      nhe1=sngl(presneutral(ntp,2))/(t(ntp)*1.38066e-16)
! dopple not used for continuum
      dopple=0.0
      xlambda=dble(xla(jp))

! COMPUTE in LTE. CAN BE CHANGED LATER.

      call hbop(xlambda,nline,nlo,nup,hlambda,
     &         nh1,nhe1,ne,t(ntp),dopple,npop,1.,0,total,cont,
     &         contonly,lineonly)

      sumabs=sumabs+cont/rosav(ntp)
!
! now HI bf absorption is included !

! add NH continuous absorption from Stancil. BPz 24/07-2019
      path='DATA/'
      pathlen=index(path,' ')-1
      NHtbl_unit=75
      opnh=nhop(xlambda,t(ntp),path,pathlen,NHtbl_unit)
! opnh is absorption in A^2/molecule
      if (nametryck(13).ne.'N H') then
        print*,nametryck(13), 'should be NH'
        stop 'PROBLEM in absko!'
      endif
! convert to cm^2/g of star
      sumabs = sumabs + opnh * 1.d-16 *
     &    partryck(ntp,13) / (t(ntp)*1.38066d-16) / rosav(ntp)
! NH cont included !
C
      if (J.gt.0) then
        ABSK(NTP)=SUMABS
        SPRID(NTP)=SUMSCA
      else
C
C        SUMMATION TO GET A ROSSELAND MEAN
ccc   25 CONTINUE
C        if(j.le.0) sumabs=sumabs + tioabs(ntp) + h2oabs(ntp)
        IF(J.EQ.0) ABSK(NTP)=ABSK(NTP)+ROSW(JP)*VIKTR/(SUMABS+SUMSCA)
        IF(J.LT.0) ABSK(NTP)=ABSK(NTP)+ROSW(JP)*VIKTR/SUMABS
        SUMW(NTP)=SUMW(NTP)+ROSW(JP)*VIKTR
      endif
! end of NTP loop
   26 CONTINUE
C
C        END OF 'THE SECOND NTP-LOOP'
C
      if (J.le.0) then
        DO NTP=1,NT
          SPRID(NTP)=0.
          ABSK(NTP)=SUMW(NTP)/ABSK(NTP)
        enddo
      endif
C
      RETURN
      END