!*********************************************************************** ! 熱源モジュール Thermal Pool ! 多数の分子間でランダムにエネルギーを交換し、仮想的な熱源を実現する ! 独立した2つのプールを用意した ! Compile: ! g95 -c thpool2.f90 ! g95 thpool2.o mtfort90.o -o thpool2 ! Date: 2007/06/07 MODULE thpool2 USE mtmod ! MT乱数モジュール使用 INTEGER, PARAMETER :: N_MOL = 3 ! 分子の数 REAL*8, PARAMETER :: MAX_EXCHANGE = 2.5d0 ! 1回に交換する最大値 REAL*8 :: Mol(1:2, 1:N_MOL) ! プール1,2の2つ CONTAINS !********************************************************************** ! 初期化 ! 初期平均エネルギー ! 初期の全エネルギーを返す(プール1,2の2つ分) REAL*8 FUNCTION pool_init(e0) IMPLICIT NONE REAL*8, INTENT(IN) :: e0 CALL sgrnd(4357) ! ランダムシード Mol = e0 ! 配列の全要素を初期化 CALL pool_run( 1000 ) ! 十分に安定するまで回す pool_init = 2 * N_MOL * e0 ! 最初に与えた全エネルギーを返す(2つ分) return END FUNCTION pool_init !********************************************************************** ! 熱浴内でのエネルギー交換を進める ! 1stepで単純に N_MOLの交換を行う SUBROUTINE pool_run(step) IMPLICIT NONE INTEGER, INTENT(IN) :: step INTEGER :: idx, st, i, j REAL*8 :: chg DO idx = 1, 2 DO st = 0, step * N_MOL ! 異なる2つの分子 i, j を選び出す i = int(grnd() * N_MOL) + 1 DO j = int(grnd() * N_MOL) + 1 IF (i /= j) THEN EXIT END IF END DO ! i -> j にエネルギーを渡す ! 交換する大きさを決める chg = MAX_EXCHANGE * grnd() IF (chg > Mol(idx, i)) THEN ! その大きさを交換できなければ Mol(idx, j) = Mol(idx, j) + Mol(idx, i) ! iを全てjに渡す Mol(idx, i) = 0.0 ELSE Mol(idx, j) = Mol(idx, j) + chg Mol(idx, i) = Mol(idx, i) - chg END IF END DO END DO END SUBROUTINE pool_run !********************************************************************** ! エネルギーの受け渡しを行う REAL*8 FUNCTION pool_get(idx, i) IMPLICIT NONE INTEGER, INTENT(IN) :: idx, i ! 対象となる分子 pool_get = Mol(idx, i) END FUNCTION pool_get SUBROUTINE pool_set(idx, i, e0) IMPLICIT NONE INTEGER, INTENT(IN) :: idx, i ! 対象となる分子 REAL*8, INTENT(IN) :: e0 Mol(idx, i) = e0 END SUBROUTINE pool_set !********************************************************************** ! 熱浴の全エネルギーを返す REAL*8 FUNCTION pool_total(idx) IMPLICIT NONE INTEGER, INTENT(IN) :: idx INTEGER :: i REAL*8 :: sum sum = 0.0 DO i=0, N_MOL sum = sum + Mol(idx, i) END DO pool_total = sum return END FUNCTION pool_total !********************************************************************** ! 熱浴内の様子を出力する SUBROUTINE pool_list IMPLICIT NONE INTEGER, PARAMETER :: N_HIST = 20 INTEGER :: hist(1:N_HIST) INTEGER :: idx, i, pos REAL*8 :: sum REAL*8, PARAMETER :: DELTA = 0.5d0 ! ヒストグラムの刻み幅 DO idx = 1, 2 hist = 0 ! 配列の0クリアー sum = 0.0 DO i=0, N_MOL pos = int( Mol(idx, i) / DELTA ) + 1 IF (pos > N_HIST) THEN pos = N_HIST END IF hist(pos) = hist(pos) + 1 sum = sum + Mol(idx, i) END DO PRINT *, idx, ':', hist(1:N_HIST), ':', sum END DO END SUBROUTINE pool_list END MODULE thpool2 !********************************************************************** ! テスト用メイン !!PROGRAM main !!USE thpool2 !!IMPLICIT NONE !! INTEGER :: i !! !! CALL pool_init(10.0) !! CALL pool_list !! !! DO i=0,100 !! CALL pool_run(1) !! CALL pool_list !! END DO !! !!END PROGRAM main !*** END of FILE *******************************************************