'*********************************************************************************
Sub ForcingData()    	'Coded by M.Kashiwai on 2004/9/12
'**********************************************************************************
'Interpolation of Forcing Factor Monthly data into daily value 
' 	by Cubic Spline as Macro on Excel Worksheet
'Original algorithm:
'	 M. Genn and K. Ida (1984):
　　　　　Numerical Calculation Program, Denki Shoin.
'Validated with Microsoft Visual Basic 6.0 on Excel 2002
'準備：	内挿するデータ（不等間隔の離散データ）をワークシート１に：
’	[データの個数]（セル“Ａ１”）
’	[日付]		[混合層深度]	[混合層水温]
’　　　　　・　　　　　　　　　　・　　　　　　　　　・
’	　・　　　　　　　　　　・		　　・
’			データの個数分
’	の形でセルにデータを書き込んでおく。
’	このマクロをそのワークシートにインポートする。
’実行：　ワークシート１のセル“Ａ１”選択しておいて、
’	マクロを実行する。
’結果：　内挿データがワークシート２に書き込まれる。

Dim I As Integer, J As Integer, K As Long
Dim L As Integer, M As Integer, N As Integer, S As Date
Dim BaseCol As Integer
Dim ItemName(6) As String
Dim FlName As Variant
Dim T() As Long, U() As Single, V() As Single
Dim X() As Integer, Y() As Single, Z() As Single
Dim D() As Single, A1() As Single, A2() As Single, A3() As Single

'Set Parameters
ItemName(1) = "TMPobs": ItemName(2) = "TMPint"
ItemName(3) = "DelTMP": ItemName(4) = "MLDobs"
ItemName(5) = "MLDint": ItemName(6) = "DelMLD"

'Read Source Data Sheet
N = ActiveSheet.Range("A1").Value
ReDim T(N), X(N), Y(N), U(N), V(N)
For I = 1 To N
    S = ActiveSheet.Cells(I + 1, 1).Value     '日付を表す文字列
    U(I) = ActiveSheet.Cells(I + 1, 2).Value  'TMPovs
    V(I) = ActiveSheet.Cells(I + 1, 3).Value  'MLD0bs
    T(I) = DateValue(S)                       '日付データ（文字列）をシリアル値に
Next I
M = T(N) - T(1) + 1
'
Worksheets(2).Activate
Worksheets(2).Cells(1, 1) = "DATE"
For J = 1 To M
    K = J + T(1) - 1
    Worksheets(2).Cells(J + 1, 1).Value = CDate(K)
Next J
L = 1
For I = 1 To N
    X(I) = T(I) - T(1) + 1
    Y(I) = U(I)
Next I
SPLINE L, M, N, X, Y, ItemName

L = 4
For I = 1 To N
    X(I) = T(I) - T(1) + 1
    Y(I) = V(I)
Next I
SPLINE L, M, N, X, Y, ItemName

End Sub :'================================================
Sub SPLINE(L, M, N, X, Y, ItemName) '********************************
'Determination of Cubic Spline Formula and Calculation of Interpolated Values
ReDim D(N), A1(N), A2(N), A3(N), Z(M)

I = 2
    W2 = (Y(I) - Y(I - 1)) / (X(I) - X(I - 1))
    W1 = (Y(I + 1) - Y(I)) / (X(I + 1) - X(I)) - W2
    W1 = W1 / (X(I + 1) - X(I - 1))
    W2 = W2 - W1 * (X(I) + X(I - 1))
    D(1) = 2 * W1 * X(1) + W2
    D(2) = 2 * W1 * X(2) + W2
For I = 3 To N - 1
    W2 = (Y(I) - Y(I - 1)) / (X(I) - X(I - 1))
    W1 = (Y(I + 1) - Y(I)) / (X(I + 1) - X(I)) - W2
    W1 = W1 / (X(I + 1) - X(I - 1))
    W2 = W2 - W1 * (X(I) + X(I - 1))
    D(I) = 2 * W1 * X(I) + W2
Next I
D(N) = 2 * W1 * X(N) + W2
For I = 1 To N - 1
        A1(I) = D(I) * (X(I + 1) - X(I))
        A2(I) = 3 * Y(I + 1) - D(I + 1) * (X(I + 1) - X(I)) - 3 * Y(I) - 2 * A1(I)
        A3(I) = Y(I + 1) - Y(I) - A1(I) - A2(I)
Next I
'
'Calculation of Interpolated Values
I = 1
For J = 1 To M
    Do While J >= X(I + 1)
        I = I + 1
        If I = N Then GoTo End_Cal
    Loop
    W = (J - X(I)) / (X(I + 1) - X(I))
    Z(J) = Y(I) + W * (A1(I) + W * (A2(I) + W * A3(I)))
Next J
End_Cal:
Z(M) = Y(N)

'Output
Worksheets(2).Activate
Worksheets(2).Cells(1, L + 1).Value = ItemName(L)
Worksheets(2).Cells(1, L + 2).Value = ItemName(L + 1)
Worksheets(2).Cells(1, L + 3).Value = ItemName(L + 2)
I = 1
For J = 1 To M
      If J = X(I) Then
         Worksheets(2).Cells(J + 1, L + 1).Value = Y(I)
         I = I + 1
      End If
    Worksheets(2).Cells(J + 1, L + 2).Value = Z(J)
      If J > 1 Then
        Worksheets(2).Cells(J + 1, L + 3).Value = Z(J) - Z(J - 1)
      End If
Next J
                
End Sub: '===============================================


日射量データを作成するマクロ
'**********************************************************************
Sub RadiationData()    'Coded by M.Kashiwai on 2004/9/12
'**********************************************************************
'Interpolate Monthly Mean Solar Radiation data into daily values
’ 	by Cubic Spline as Macro on Excel Worksheet
'Original algorithm:
' 	M. Genn and K. Ida (1984):
’	Numerical Calculation Program, Denki Shoin.
'Validated with Microsoft Visual Basic 6.0 on Excel 2002
'準備：	内挿する日射量データ（月平均値データ）をワークシート１に：
’	[データの個数]（セル“Ａ１”）
’	[日付]（前年12/15から）[日射量月平均値]]（前年１２月値）
’　　　　　・　　　　　　　　　	・　　　　　
’	　・ （翌年1/15まで）　　　　	・      （翌年１月値）
’				データの個数分
’	の形でセルにデータを書き込んでおく。
’	このマクロをそのワークシートにインポートする。
’実行：　ワークシート１のセル“Ａ１”選択しておいて、
’	マクロを実行する。
’結果：　内挿データがワークシート２に書き込まれる。
’	必要な当該年の1/1〜12/31分のデータを入力データ用とする。
Dim I As Integer, J As Integer, K As Long
Dim L As Integer, M As Integer, N As Integer, S As Date
Dim BaseCol As Integer
Dim ItemName(6) As String
Dim FlName As Variant
Dim T() As Long, U() As Single, V() As Single
Dim X() As Integer, Y() As Single, Z() As Single
Dim D() As Single, A1() As Single, A2() As Single, A3() As Single


'Set Parameters
ItemName(1) = "RADobv": ItemName(2) = "PARint"
'Read Source Data Sheet
N = ActiveSheet.Range("A1").Value
ReDim T(N), X(N), Y(N), U(N)
For I = 1 To N
    S = ActiveSheet.Cells(I + 1, 1).Value     '日付を表す文字列
    U(I) = ActiveSheet.Cells(I + 1, 2).Value  'RADovs
    T(I) = DateValue(S)           '日付データ（文字列）をシリアル値に
Next I
M = T(N) - T(1) + 1
'
Worksheets(2).Activate
Worksheets(2).Cells(1, 1) = "DATE"
For J = 1 To M
    K = J + T(1) - 1
    Worksheets(2).Cells(J + 1, 1).Value = CDate(K)
Next J
L = 1
For I = 1 To N
    X(I) = T(I) - T(1) + 1
    Y(I) = U(I)
Next I
SPLINE L, M, N, X, Y, ItemName

End Sub:'====================================================
Sub SPLINE(L, M, N, X, Y, ItemName)' '********************************
'Determination of Cubic Spline Formula and Calculation of Interporated Values
ReDim D(N), A1(N), A2(N), A3(N), Z(M)

I = 2
    W2 = (Y(I) - Y(I - 1)) / (X(I) - X(I - 1))
    W1 = (Y(I + 1) - Y(I)) / (X(I + 1) - X(I)) - W2
    W1 = W1 / (X(I + 1) - X(I - 1))
    W2 = W2 - W1 * (X(I) + X(I - 1))
    D(1) = 2 * W1 * X(1) + W2
    D(2) = 2 * W1 * X(2) + W2
For I = 3 To N - 1
    W2 = (Y(I) - Y(I - 1)) / (X(I) - X(I - 1))
    W1 = (Y(I + 1) - Y(I)) / (X(I + 1) - X(I)) - W2
    W1 = W1 / (X(I + 1) - X(I - 1))
    W2 = W2 - W1 * (X(I) + X(I - 1))
    D(I) = 2 * W1 * X(I) + W2
Next I
D(N) = 2 * W1 * X(N) + W2
For I = 1 To N - 1
        A1(I) = D(I) * (X(I + 1) - X(I))
        A2(I) = 3 * Y(I + 1) - D(I + 1) * (X(I + 1) - X(I)) - 3 * Y(I) - 2 * A1(I)
        A3(I) = Y(I + 1) - Y(I) - A1(I) - A2(I)
Next I
'
'Calculation of Interpolated Values
I = 1
For J = 1 To M
    Do While J >= X(I + 1)
        I = I + 1
        If I = N Then GoTo End_Cal
    Loop
    W = (J - X(I)) / (X(I + 1) - X(I))
    Z(J) = Y(I) + W * (A1(I) + W * (A2(I) + W * A3(I)))
Next J
End_Cal:
'Output
Worksheets(2).Activate
Worksheets(2).Cells(1, L + 1).Value = ItemName(L)
Worksheets(2).Cells(1, L + 2).Value = ItemName(L + 1)
I = 1
For J = 1 To M
      If J = X(I) Then
         Worksheets(2).Cells(J + 1, L + 1).Value = Y(I)
         I = I + 1
      End If
    Worksheets(2).Cells(J + 1, L + 2).Value = Z(J)
Next J
End Sub：'===============================================