!= 地下における熱の鉛直拡散 ! != Vertical diffusion of heat under the ground ! ! Authors:: Yoshiyuki O. Takahashi ! Version:: $Id: subsurface_diffusion_heat.f90,v 1.10 2015/01/29 12:07:59 yot Exp $ ! Tag Name:: $Name: $ ! Copyright:: Copyright (C) GFD Dennou Club, 2008-2009. All rights reserved. ! License:: See COPYRIGHT[link:../../../COPYRIGHT] ! module subsurface_diffusion_heat ! != 地下の鉛直拡散 ! != Vertical diffusion under the ground ! ! Note that Japanese and English are described in parallel. ! !== Procedures List ! ! SubsurfaceDiffusion :: 熱伝導フラックスの計算 ! SubsurfaceDiffusionInit :: 初期化サブルーチン ! ----------------------- :: ------------ ! SubsurfaceDiffusion :: Calculate thermal conduction flux ! SubsurfaceDiffusionInit :: Initialization ! !-- !== NAMELIST ! ! NAMELIST#subsurface_diffusion_heat_nml !++ ! モジュール引用 ; USE statements ! ! 格子点設定 ! Grid points settings ! use gridset, only: imax, & ! 経度格子点数. ! Number of grid points in longitude & jmax, & ! 緯度格子点数. ! Number of grid points in latitude & kmax, & ! 鉛直層数. ! Number of vertical level & kslmax ! 地下の鉛直層数. ! Number of subsurface vertical level ! 種別型パラメタ ! Kind type parameter ! use dc_types, only: DP, & ! 倍精度実数型. Double precision. & STRING ! 文字列. Strings. ! メッセージ出力 ! Message output ! use dc_message, only: MessageNotify ! 宣言文 ; Declaration statements ! implicit none private ! 公開手続き ! Public procedure ! !!$ public:: SubsurfaceDiffusionFlagLand public:: SubsurfaceDiffusion public:: SubsurfaceDiffusionInit ! 公開変数 ! Public variables ! ! 非公開変数 ! Private variables ! logical, save :: subsurface_diffusion_inited = .false. ! 初期設定フラグ. ! Initialization flag character(*), parameter:: module_name = 'subsurface_diffusion_heat' ! モジュールの名称. ! Module name character(*), parameter:: version = & & '$Name: $' // & & '$Id: subsurface_diffusion_heat.f90,v 1.10 2015/01/29 12:07:59 yot Exp $' ! モジュールのバージョン ! Module version contains !-------------------------------------------------------------------------------------- !!$ subroutine SubsurfaceDiffusionFlagLand( & !!$ & xy_SurfType, & ! (in) !!$ & xy_FlagMatthewsLand & ! (out) !!$ & ) !!$ ! !!$ ! !!$ ! !!$ ! Set index for calculation method from Matthews' index !!$ ! !!$ !!$ ! モジュール引用 ; USE statements !!$ ! !!$ !!$ ! 雪と海氷の定数の設定 !!$ ! Setting constants of snow and sea ice !!$ ! !!$ use constants_snowseaice, only: & !!$ & SeaIceThreshold !!$ !!$ !!$ ! 宣言文 ; Declaration statements !!$ ! !!$ !!$ integer , intent(in ) :: xy_SurfType (0:imax-1, 1:jmax) !!$ ! 土地利用. !!$ ! Surface index !!$ logical , intent(out) :: xy_FlagMatthewsLand(0:imax-1, 1:jmax) !!$ ! !!$ ! Flag for land grid box !!$ !!$ !!$ ! 作業変数 !!$ ! Work variables !!$ ! !!$ !!$ integer:: i ! 経度方向に回る DO ループ用作業変数 !!$ ! Work variables for DO loop in longitude !!$ integer:: j ! 緯度方向に回る DO ループ用作業変数 !!$ ! Work variables for DO loop in latitude !!$ !!$ !!$ ! 実行文 ; Executable statement !!$ ! !!$ !!$ ! 初期化確認 !!$ ! Initialization check !!$ ! !!$ if ( .not. subsurface_diffusion_inited ) then !!$ call MessageNotify( 'E', module_name, 'This module has not been initialized.' ) !!$ end if !!$ !!$ ! !!$ ! Set flag for land !!$ ! !!$ do j = 1, jmax !!$ do i = 0, imax-1 !!$ if ( xy_SurfType(i,j) >= 1 ) then !!$ ! land !!$ xy_FlagMatthewsLand(i,j) = .true. !!$ else !!$ ! others !!$ xy_FlagMatthewsLand(i,j) = .false. !!$ end if !!$ end do !!$ end do !!$ !!$ !!$ end subroutine SubsurfaceDiffusionFlagLand !-------------------------------------------------------------------------------------- subroutine SubsurfaceDiffusion( & & xy_DeepSubSurfHeatFlux, & ! (in ) & xy_SoilHeatCap, xy_SoilHeatDiffCoef, & ! (in ) & xy_SurfTemp, xyz_SoilTemp, xy_SurfSnowB, & ! (in ) & xyr_SoilTempTransCoef, xyr_SoilHeatFlux & ! (out) & ) ! ! 時間変化率の計算を行います. ! ! Calculate tendencies. ! ! モジュール引用 ; USE statements ! ! 時刻管理 ! Time control ! use timeset, only: & & TimesetClockStart, TimesetClockStop ! 座標データ設定 ! Axes data settings ! use axesset, only: & z_SSDepth ! subsurface grid at midpoint of layer ! 雪と海氷の定数の設定 ! Setting constants of snow and sea ice ! use constants_snowseaice, only: & & SnowDens, & & SnowMaxThermDepth, & & SnowThermCondCoef ! 宣言文 ; Declaration statements ! implicit none real(DP), intent(in ):: xy_DeepSubSurfHeatFlux (0:imax-1, 1:jmax) ! 地中熱フラックス. ! "Deep subsurface heat flux" ! Heat flux at the bottom of surface/soil layer. real(DP), intent(in ):: xy_SoilHeatCap (0:imax-1, 1:jmax) ! 土壌熱容量 (J K-1 kg-1) ! Specific heat of soil (J K-1 kg-1) real(DP), intent(in ):: xy_SoilHeatDiffCoef (0:imax-1, 1:jmax) ! 土壌熱伝導係数 (J m-3 K-1) ! Heat conduction coefficient of soil (J m-3 K-1) real(DP), intent(in ):: xy_SurfTemp (0:imax-1, 1:jmax) ! 地表面温度. ! Surface temperature real(DP), intent(in ):: xyz_SoilTemp (0:imax-1, 1:jmax, 1:kslmax) ! 土壌温度 (K) ! Soil temperature (K) real(DP), intent(in ):: xy_SurfSnowB (0:imax-1, 1:jmax) ! 積雪量. ! Surface snow amount. real(DP), intent(out):: xyr_SoilTempTransCoef (0:imax-1, 1:jmax, 0:kslmax) ! 輸送係数：土壌温度. ! Transfer coefficient: soil temperature real(DP), intent(out):: xyr_SoilHeatFlux (0:imax-1, 1:jmax, 0:kslmax) ! 土壌中の熱フラックス. ! Heat flux in sub-surface soil ! 作業変数 ! Work variables ! real(DP) :: xy_SnowDepth (0:imax-1, 1:jmax) real(DP) :: xy_SurfTransCoefCorFactor(0:imax-1, 1:jmax) integer:: k ! 鉛直方向に回る DO ループ用作業変数 ! Work variables for DO loop in vertical direction ! 実行文 ; Executable statement ! ! 初期化確認 ! Initialization check ! if ( .not. subsurface_diffusion_inited ) then call MessageNotify( 'E', module_name, 'This module has not been initialized.' ) end if ! 計算時間計測開始 ! Start measurement of computation time ! call TimesetClockStart( module_name ) ! 土壌温度計算用の輸送係数の計算 ! Calculate transfer coefficient for heat diffusion in the soil ! k = 0 if ( kslmax == 0 ) then ! This line is used when kslmax == 0, because z_SSDepth(k+1) does not exist. xyr_SoilTempTransCoef(:,:,k) = 0.0_DP else !!$ xyr_SoilTempTransCoef(:,:,k) = & !!$ & xy_SoilHeatDiffCoef(:,:) / ( z_SSDepth(k+1) - 0.0_DP ) !!$ xyr_SoilTempTransCoef(:,:,k) = & !!$ & ( ( z_SSDepth(k+1) - 0.0_DP ) / xy_SoilHeatDiffCoef & !!$ & - min( max( xy_SurfSnowB / SnowDens, 0.0_DP ), SnowMaxThermDepth )& !!$ & / SnowThermCondCoef )**(-1) xyr_SoilTempTransCoef(:,:,k) = & & xy_SoilHeatDiffCoef(:,:) / ( z_SSDepth(k+1) - 0.0_DP ) xy_SnowDepth = min( max( xy_SurfSnowB / SnowDens, 0.0_DP ), & & SnowMaxThermDepth ) xy_SurfTransCoefCorFactor = & & SnowThermCondCoef * ( z_SSDepth(k+1) - 0.0_DP ) & & / ( SnowThermCondCoef * ( z_SSDepth(k+1) - 0.0_DP ) & & + xy_SoilHeatDiffCoef * ( 0.0_DP - xy_SnowDepth ) ) xyr_SoilTempTransCoef(:,:,k) = xyr_SoilTempTransCoef(:,:,k) & & * xy_SurfTransCoefCorFactor end if do k = 1, kslmax-1 xyr_SoilTempTransCoef(:,:,k) = & & xy_SoilHeatDiffCoef(:,:) / ( z_SSDepth(k+1) - z_SSDepth(k) ) end do k = kslmax xyr_SoilTempTransCoef(:,:,k) = 0.0_DP ! 土壌中の熱フラックスの計算 ! Calculate heat flux in sub-surface soil ! k = 0 if ( kslmax == 0 ) then ! This line is used when kslmax == 0, because xyz_SoilTemp(:,:,k+1) does not exist. xyr_SoilHeatFlux(:,:,k) = 0.0_DP else xyr_SoilHeatFlux(:,:,k) = & & - xyr_SoilTempTransCoef(:,:,k) * ( xyz_SoilTemp(:,:,1) - xy_SurfTemp(:,:) ) end if do k = 1, kslmax-1 xyr_SoilHeatFlux(:,:,k) = & & - xyr_SoilTempTransCoef(:,:,k) & & * ( xyz_SoilTemp(:,:,k+1) - xyz_SoilTemp(:,:,k) ) end do k = kslmax xyr_SoilHeatFlux(:,:,k) = xy_DeepSubSurfHeatFlux ! 計算時間計測一時停止 ! Pause measurement of computation time ! call TimesetClockStop( module_name ) end subroutine SubsurfaceDiffusion !------------------------------------------------------------------- subroutine SubsurfaceDiffusionInit ! ! subsurface_diffusion_heat モジュールの初期化を行います. ! NAMELIST#subsurface_diffusion_heat_nml の読み込みはこの手続きで行われます. ! ! "subsurface_diffusion_heat" module is initialized. ! "NAMELIST#subsurface_diffusion_heat_nml" is loaded in this procedure. ! ! モジュール引用 ; USE statements ! ! NAMELIST ファイル入力に関するユーティリティ ! Utilities for NAMELIST file input ! !!$ use namelist_util, only: namelist_filename, NmlutilMsg, NmlutilAryValid ! ファイル入出力補助 ! File I/O support ! use dc_iounit, only: FileOpen ! 種別型パラメタ ! Kind type parameter ! use dc_types, only: STDOUT ! 標準出力の装置番号. Unit number of standard output ! 文字列操作 ! Character handling ! use dc_string, only: StoA ! ヒストリデータ出力 ! History data output ! use gtool_historyauto, only: HistoryAutoAddVariable ! メッセージ出力 ! Message output ! use dc_message, only: MessageNotify ! 宣言文 ; Declaration statements ! implicit none ! 作業変数 ! Work variables ! !!$ integer:: unit_nml ! NAMELIST ファイルオープン用装置番号. !!$ ! Unit number for NAMELIST file open !!$ integer:: iostat_nml ! NAMELIST 読み込み時の IOSTAT. !!$ ! IOSTAT of NAMELIST read !!$ real(DP) :: SoilHeatCap !!$ real(DP) :: SoilHeatDiffCoef ! NAMELIST 変数群 ! NAMELIST group name ! !!$ namelist /subsurface_diffusion_heat_nml/ & !!$ & SoilHeatCap, SoilHeatDiffCoef !!$ ! !!$ ! デフォルト値については初期化手続 "subsurface_diffusion_heat#SubSurfaceDiffusionInit" !!$ ! のソースコードを参照のこと. !!$ ! !!$ ! Refer to source codes in the initialization procedure !!$ ! "subsurface_diffusion_heat#SubsurfaceDiffusionInit" for the default values. !!$ ! ! 実行文 ; Executable statement ! if ( subsurface_diffusion_inited ) return ! デフォルト値の設定 ! Default values settings ! ! NAMELIST の読み込み ! NAMELIST is input ! !!$ if ( trim(namelist_filename) /= '' ) then !!$ call FileOpen( unit_nml, & ! (out) !!$ & namelist_filename, mode = 'r' ) ! (in) !!$ !!$ rewind( unit_nml ) !!$ read( unit_nml, & ! (in) !!$ & nml = subsurface_diffusion_heat_nml, & ! (out) !!$ & iostat = iostat_nml ) ! (out) !!$ close( unit_nml ) !!$ !!$ call NmlutilMsg( iostat_nml, module_name ) ! (in) !!$ end if ! 印字 ; Print ! call MessageNotify( 'M', module_name, '----- Initialization Messages -----' ) call MessageNotify( 'M', module_name, '-- version = %c', c1 = trim(version) ) subsurface_diffusion_inited = .true. end subroutine SubsurfaceDiffusionInit !------------------------------------------------------------------- end module subsurface_diffusion_heat