!  FUNCTIONS/SUBROUTINES exported from McFortranModelTPL.dll:
!  McFortranModelTPL      - subroutine
!
subroutine McCommonSubTPL
  ! Expose subroutine McFortranModelTPL to users of this DLL
  !
  !DEC$ ATTRIBUTES DLLEXPORT::McCommonSubTPL
  ! Variables
  ! Body of McCommonSubTPL
    implicit none

    integer MAXPARA,MAXIN,MAXOUT
    PARAMETER(MAXPARA=64)
    PARAMETER(MAXIN=500)
    PARAMETER(MAXOUT=500)

    ! モデルのプロパティ（パラメータ）情報格納領域
    ! モデルの初期値（パラメータ）情報格納領域
    COMMON /PRPTY/ LParaNum, LPara(0:MAXPARA), DParaNum, DPara(0:MAXPARA)
    COMMON /INITVAL/ LValNum, LVal(0:MAXPARA), DValNum, DVal(0:MAXPARA)
    Integer LParaNum, LPara, DParaNum, LValNum, LVal, DValNum
    Real(8) DPara, DVal

    ! モデル内の時間（シミュレーション時刻、計算目標時刻、δT）
    COMMON /CTL/SimTime,TargetTime,deltaT
    Real(8) SimTime,TargetTime,deltaT

    ! 外部からの受信情報（受信配列（生）データ）
    COMMON /RECVDT/RcvDtNum,RcvDt(0:MAXIN),RcvTime,validFlg
    Real(8) RcvDt,RcvTime
    Integer validFlg,RcvDtNum
    ! 計算結果送信情報（送信配列（生）データ）
    COMMON /SENDDT/SndDtNum,SndDt(0:MAXOUT),SndTime
    Real(8) SndDt,SndTime
    Integer SndDtNum

    ! 受信情報を配列化したデータ
    !COMMON /DIMCOM/ lDim1,lDim2,lDim3,lDataDimInCell
    !COMMON /D1RCVDT/  RvDt1(0:10,0:10)
    !Integer lDim1,lDim2,lDim3,lDataDimInCell
    !Real(8) RvDt0,RvDt1,RvDt2,RvDt3
    ! 送信情報を配列化したデータ
end subroutine McCommonSubTPL

!
! 受信エリアの配列数取得
integer function MAXRCVDIM()
  !DEC$ ATTRIBUTES DLLEXPORT::MAXRCVDIM
  !DEC$ ATTRIBUTES STDCALL::MAXRCVDIM
  !DEC$ ATTRIBUTES ALIAS:'FGetMaxReceiveDataDim'::MAXRCVDIM
    PARAMETER(MAXIN=500)
    MAXRCVDIM=MAXIN
    return
end function MAXRCVDIM

!
!  送信エリアの配列数取得
integer function MAXSNDDIM()
  !DEC$ ATTRIBUTES DLLEXPORT::MAXSNDDIM
  !DEC$ ATTRIBUTES STDCALL::MAXSNDDIM
  !DEC$ ATTRIBUTES ALIAS:'FGetMaxSendDataDim'::MAXSNDDIM
    PARAMETER(MAXOUT=500)
    MAXSNDDIM=MAXOUT
    return
end function MAXSNDDIM

!
!  パラメーター受信エリアの配列数取得
integer function MAXPARANUM()
  !DEC$ ATTRIBUTES DLLEXPORT::MAXPARANUM
  !DEC$ ATTRIBUTES STDCALL::MAXPARANUM
  !DEC$ ATTRIBUTES ALIAS:'FGetMaxParaDim'::MAXPARANUM
    PARAMETER(MAXPARA=64)
    MAXPARANUM=MAXPARA
    return
end function MAXPARANUM

!
!  プロパティ設定
integer function PRESET( LDTNUM, LDATA, DDTNUM, DDATA )
    !DEC$ ATTRIBUTES DLLEXPORT::PRESET
    !DEC$ ATTRIBUTES STDCALL::PRESET
    !DEC$ ATTRIBUTES ALIAS:'FSetProperty'::PRESET
    !DEC$ ATTRIBUTES REFERENCE ::LDTNUM
    !DEC$ ATTRIBUTES REFERENCE ::LDATA
    !DEC$ ATTRIBUTES REFERENCE ::DDTNUM
    !DEC$ ATTRIBUTES REFERENCE ::DDATA
    implicit none
    integer MAXPARA
    PARAMETER(MAXPARA=64)
    Integer LDTNUM(0:1), LDATA(0:MAXPARA), DDTNUM(0:1)
    Real(8) DDATA(0:MAXPARA)
    COMMON /PRPTY/ LParaNum, LPara(0:MAXPARA), DParaNum, DPara(0:MAXPARA)
    COMMON /INITVAL/ LValNum, LVal(0:MAXPARA), DValNum, DVal(0:MAXPARA)
    Integer LParaNum, LPara, DParaNum, LValNum, LVal, DValNum
    Real(8) DPara, DVal

    integer J,IRTN

    LParaNum = LDTNUM(0)
    DParaNum = DDTNUM(0)

    DO 10 J=0,LParaNum-1
            LPara(J) = LDATA(J)
    10 CONTINUE
    DO 20 J=0,DParaNum-1
            DPara(J) = DDATA(J)
    20 CONTINUE

    CALL SetProperty
!    PRESET = SetProperty() SetProperty の戻り値を　PRESETの値とする
    PRESET = 0

    return
end function PRESET

!
!  δT設定
subroutine SETDLTTM( DLTT )
    !DEC$ ATTRIBUTES DLLEXPORT::SETDLTTM
    !DEC$ ATTRIBUTES STDCALL::SETDLTTM
    !DEC$ ATTRIBUTES ALIAS:'FSetDeltaTime'::SETDLTTM
    !DEC$ ATTRIBUTES REFERENCE ::DLTT
    implicit none
    Real(8) DLTT
    COMMON /CTL/SimTime,TargetTime,deltaT
    Real(8) SimTime,TargetTime,deltaT
    deltaT = DLTT
!                                    WRITE(1,110) SimTime,TargetTime,deltaT
!                                110 FORMAT('FSetDeltaTime',T16,F12.3, ',' ,F12.3, ',' ,F12.3 )
end subroutine SETDLTTM

!
!  初期化処理
integer function INIT( LDTNUM, LDATA, DDTNUM, DDATA )
    !DEC$ ATTRIBUTES DLLEXPORT::INIT
    !DEC$ ATTRIBUTES STDCALL::INIT
    !DEC$ ATTRIBUTES ALIAS:'FInitialize'::INIT
    !DEC$ ATTRIBUTES REFERENCE ::LDTNUM
    !DEC$ ATTRIBUTES REFERENCE ::LDATA
    !DEC$ ATTRIBUTES REFERENCE ::DDTNUM
    !DEC$ ATTRIBUTES REFERENCE ::DDATA
    implicit none
    integer MAXPARA
    PARAMETER(MAXPARA=64)
    Integer LDTNUM(0:1), LDATA(0:MAXPARA), DDTNUM(0:1)
    Real(8) DDATA(0:MAXPARA)
    COMMON /CTL/SimTime,TargetTime,deltaT
    Real(8) SimTime,TargetTime,deltaT
    COMMON /PRPTY/ LParaNum, LPara(0:MAXPARA), DParaNum, DPara(0:MAXPARA)
    COMMON /INITVAL/ LValNum, LVal(0:MAXPARA), DValNum, DVal(0:MAXPARA)
    Integer LParaNum, LPara, DParaNum, LValNum, LVal, DValNum
    Real(8) DPara, DVal

    Integer J

    LValNum = LDTNUM(0)
    DValNum = DDTNUM(0)

    DO 10 J=0,LValNum-1
            LVal(J) = LDATA(J)
    10 CONTINUE
    DO 20 J=0,DValNum-1
            DVal(J) = DDATA(J)
    20 CONTINUE


    SimTime = 0.0

    CALL Initialize
!    INIT=Initialize() !  Initialize の戻り値を　INITの値とする
    INIT=0
    return
end function INIT

!
!  収束判断
integer function ISCONVERGED()
    !DEC$ ATTRIBUTES DLLEXPORT::ISCONVERGED
    !DEC$ ATTRIBUTES STDCALL::ISCONVERGED
    !DEC$ ATTRIBUTES ALIAS:'FIsConverged'::ISCONVERGED
    implicit none
    COMMON /CTL/SimTime,TargetTime,deltaT
    Real(8) SimTime,TargetTime,deltaT

    if( SimTime >= TargetTime ) then
        ISCONVERGED = 1
!                                    WRITE(1,110) SimTime,TargetTime,deltaT
!                                110 FORMAT('Converged',T16,F12.3, ',' ,F12.3, ',' ,F12.3 /)

    else
        ISCONVERGED = 0
!                                    WRITE(1,111) SimTime,TargetTime,deltaT
!                                111 FORMAT('NotConverged',T16,F12.3, ',' ,F12.3, ',' ,F12.3 )
    endif
    return
end function ISCONVERGED

!
!  時刻を進める
subroutine GAINTIME
  !DEC$ ATTRIBUTES DLLEXPORT::GAINTIME
  !DEC$ ATTRIBUTES STDCALL::GAINTIME
  !DEC$ ATTRIBUTES ALIAS:'FGainSimuTime'::GAINTIME
  implicit none
  COMMON /CTL/SimTime,TargetTime,deltaT
  Real(8) SimTime,TargetTime,deltaT
  SimTime = SimTime + deltaT
!                                    WRITE(1,110) SimTime,TargetTime,deltaT
!                                110 FORMAT('FGainSimuTime',T16,F12.3, ',' ,F12.3, ',' ,F12.3 )
end subroutine GAINTIME

!
!  取得したい時刻を知らせる
Real(8) function WANTDATATIME( )
    !DEC$ ATTRIBUTES DLLEXPORT::WANTDATATIME
    !DEC$ ATTRIBUTES STDCALL::WANTDATATIME
    !DEC$ ATTRIBUTES ALIAS:'FWantTime'::WANTDATATIME
    implicit none
    integer MAXIN
    PARAMETER(MAXIN=500)
    COMMON /RECVDT/RcvDtNum,RcvDt(0:MAXIN),RcvTime,validFlg
    Real(8) RcvDt,RcvTime
    Integer validFlg,RcvDtNum

    call GetRcvDataTime

    WANTDATATIME = RcvTime
    return
end function WANTDATATIME

!
!  受信情報取得処理
subroutine RECIVEDATA( LNUM, DIN, DINTM, DFLG, DTPTN )
    !DEC$ ATTRIBUTES DLLEXPORT::RECIVEDATA
    !DEC$ ATTRIBUTES STDCALL::RECIVEDATA
    !DEC$ ATTRIBUTES ALIAS:'FGetRcvData'::RECIVEDATA
    !DEC$ ATTRIBUTES REFERENCE ::LNUM
    !DEC$ ATTRIBUTES REFERENCE ::DIN
    !DEC$ ATTRIBUTES REFERENCE ::DINTM
    !DEC$ ATTRIBUTES REFERENCE ::DFLG
    !DEC$ ATTRIBUTES REFERENCE ::DTPTN
    implicit none
    integer MAXIN
    PARAMETER(MAXIN=500)
    Integer LNUM(0:1), DTPTN(0:1),DFLG(0:1)
    Real(8) DIN(0:MAXIN), DINTM(0:1)

    COMMON /RECVDT/RcvDtNum,RcvDt(0:MAXIN),RcvTime,validFlg
    Real(8) RcvDt,RcvTime
    Integer validFlg,RcvDtNum
    integer J

    ! 受信した情報をCommon領域へ格納
    RcvDtNum = LNUM(0)
    validFlg = DFLG(0)
    RcvTime = DINTM(0)
    if( validFlg == 1 ) then
        DO 10 J=0,RcvDtNum-1
            RcvDt(J) = DIN(J)
    10 CONTINUE
    endif

    ! Common領域から受信情報を取得
    CALL GetRcvData(DTPTN(0))

end subroutine RECIVEDATA

!
!  計算実行処理
integer function CALMODEL()
    !DEC$ ATTRIBUTES DLLEXPORT::CALMODEL
    !DEC$ ATTRIBUTES STDCALL::CALMODEL
    !DEC$ ATTRIBUTES ALIAS:'FCalculate'::CALMODEL

    CALMODEL=Calculate()
end function CALMODEL

!
!  計算結果送信処理
subroutine SENDDATA( LNUM, DOUT, DOUTTM, DTPTN )
    !DEC$ ATTRIBUTES DLLEXPORT::SENDDATA
    !DEC$ ATTRIBUTES STDCALL::SENDDATA
    !DEC$ ATTRIBUTES ALIAS:'FSetSndData'::SENDDATA
    !DEC$ ATTRIBUTES REFERENCE ::LNUM
    !DEC$ ATTRIBUTES REFERENCE ::DOUT
    !DEC$ ATTRIBUTES REFERENCE ::DOUTTM
    !DEC$ ATTRIBUTES REFERENCE ::DTPTN
    implicit none
    integer MAXOUT
    PARAMETER(MAXOUT=500)
    Integer LNUM(0:1), DTPTN(0:1)
    Real(8) DOUT(0:MAXOUT), DOUTTM(0:1)

    COMMON /CTL/SimTime,TargetTime,deltaT
    Real(8) SimTime,TargetTime,deltaT
    COMMON /SENDDT/SndDtNum,SndDt(0:MAXOUT),SndTime
    Real(8) SndDt,SndTime
    Integer SndDtNum

    integer J

    SndTime = SimTime

    ! データパターン別にCommon領域にデータを設定する
    CALL PutSndData(DTPTN(0))

    ! Common領域の情報を　引数に設定する
    LNUM(0) = SndDtNum;
    DOUTTM(0) = SndTime;

    DO 10 J=0,SndDtNum-1
        DOUT(J) = SndDt(J)
    10 CONTINUE

end subroutine SENDDATA

!
!  δT設定
subroutine SETTGTTM( TGTT )
    !DEC$ ATTRIBUTES DLLEXPORT::SETTGTTM
    !DEC$ ATTRIBUTES STDCALL::SETTGTTM
    !DEC$ ATTRIBUTES ALIAS:'FSetTargetTime'::SETTGTTM
    !DEC$ ATTRIBUTES REFERENCE ::TGTT
    implicit none
    COMMON /CTL/SimTime,TargetTime,deltaT
    Real(8) SimTime,TargetTime,deltaT
    Real(8) TGTT
    TargetTime = TGTT
!                                    WRITE(1,110) SimTime,TargetTime,deltaT
!                                110 FORMAT('FSetTargetTime',T16,F12.3, ',' ,F12.3, ',' ,F12.3 )
end subroutine SETTGTTM


! ============================================================
! ============================================================
!
!  計算開始時にコールされる処理
integer function CALSTART()
    !DEC$ ATTRIBUTES DLLEXPORT::CALSTART
    !DEC$ ATTRIBUTES STDCALL::CALSTART
    !DEC$ ATTRIBUTES ALIAS:'FReadyCalculation'::CALSTART

    CALSTART=StartCalc()
end function CALSTART

!
!  計算終了時にコールされる処理
integer function CALEND()
    !DEC$ ATTRIBUTES DLLEXPORT::CALEND
    !DEC$ ATTRIBUTES STDCALL::CALEND
    !DEC$ ATTRIBUTES ALIAS:'FCompleteCalculation'::CALEND

    CALEND=EndCalc()
end function CALEND


!
!  計算終了時にコールされる処理
integer function CALSUSP()
    !DEC$ ATTRIBUTES DLLEXPORT::CALSUSP
    !DEC$ ATTRIBUTES STDCALL::CALSUSP
    !DEC$ ATTRIBUTES ALIAS:'FSuspendCalculation'::CALSUSP

    CALSUSP=SuspendCalc()
end function CALSUSP

!=============================================================
! 便利共通サブルーティン
!=============================================================
!
!subroutine GetD0RcvData( csTm,  csInputCellData,  lDim1,  lDataDimInCell)
!end subroutine GetD0RcvData

! 受信情報を１次元の情報に移し変える
subroutine GetD0CellData( DimCell,CellDt )
implicit none
integer DimCell
Real(8) CellDt
Dimension CellDt(DimCell)

end subroutine GetD0CellData
!
subroutine GetD1CellData( CellDim1, DimCell, CellDt)
implicit none
integer CellDim1,DimCell
Real(8) CellDt
Dimension CellDt(CellDim1,DimCell)
end subroutine GetD1CellData
!subroutine GetD2RcvData( csTm,  csInputCellData,  lDim1,  lDim2,  lDataDimInCell)
!end subroutine GetD2RcvData
!subroutine GetD3RcvData( csTm,  csInputCellData,  lDim1,  lDim2,  lDim3,  lDataDimInCell)
!end subroutine GetD3RcvData
subroutine PutD1OutData( CellDim1, DimCell, CellDt)
    implicit none
    Integer MAXOUT
    PARAMETER(MAXOUT=500)
    Integer CellDim1,DimCell
    Real(8) CellDt
    Dimension CellDt(CellDim1,DimCell)
    COMMON /SENDDT/SndDtNum,SndDt(0:MAXOUT),SndTime
    Real(8) SndDt,SndTime
    Integer SndDtNum

    integer LPCell1,LPinCell, LDtCnt
    LDtCnt=0
    DO 10 LPCell1=1,CellDim1
        DO 20 LPinCell=1,DimCell
            SndDt(LDtCnt)=CellDt(LPCell1,LPinCell)
            LDtCnt = LDtCnt + 1
        20 CONTINUE
    10 CONTINUE
end subroutine PutD1OutData
!subroutine PutD2OutData( lDim1,  lDim2,  lDataDimInCell,  csOutputCellData)
!end subroutine PutD2OutData
!subroutine PutD3OutData( lDim1,  lDim2,  lDim3,  lDataDimInCell,  csOutputCellData)
!end subroutine PutD3OutData

!==========================================================
! ディバッグ時に使用する便利ツール
!==========================================================
!
!  ディバッグ用ファイルオープン
subroutine DebugOpen()
COMMON /DEBUG/ iDbgFlg
    iDbgFlg = 1  ! ディバッグ終了後は　iDbgFlg=0 に設定する
    if( iDbgFlg == 1 ) then
        OPEN(1,FILE='McFortranModelTPL.log',STATUS='UNKNOWN')
    endif
end subroutine DebugOpen

!
!  ディバッグ用ファイルクローズ
subroutine DebugClose()
COMMON /DEBUG/ iDbgFlg
    if( iDbgFlg == 1 ) then
        CLOSE(1)
    endif
end subroutine DebugClose

!
!  ディバッグ用出力
subroutine DebugOut( str )
character(*) str
COMMON /DEBUG/ iDbgFlg
    if( iDbgFlg == 1 ) then
        WRITE(1,100) str
    100 FORMAT(A)
    endif
end subroutine DebugOut
