!--------------------------------------------------------------------- ! Copyright (C) GFD Dennou Club, 2005. All rights reserved. !--------------------------------------------------------------------- !=begin != Module dycore_hs94forcing_mod ! ! * Developers: Morikawa Yasuhiro ! * Version: $Id: dycore_hs94forcing.f90,v 1.1.1.1 2005/11/08 14:10:24 morikawa Exp $ ! * Tag Name: $Name: dcpam3-20061118 $ ! * Change History: ! !== Overview ! !Call ((< hs94forcing_mod >)). ! !== Error Handling ! !== Known Bugs ! !== Note ! !== Future Plans ! ! !=end module dycore_hs94forcing_mod !=begin !== Dependency use type_mod, only : STRING, DBKIND !=end implicit none !=begin !== Public Interface private public :: dycore_hs94forcing_init ! subroutines public :: dycore_hs94forcing ! subroutines public :: dycore_hs94forcing_end ! subroutines !=end real(DBKIND), save, allocatable :: & & xyz_VelLon_phy(:,:,:) , & ! 速度経度成分の加熱散逸効果 & xyz_VelLat_phy(:,:,:) , & ! 速度緯度成分の加熱散逸効果 & xyz_Temp_phy(:,:,:) ! 温度の加熱散逸効果 !for Generate Velocity from Vorticity and Divergence real(DBKIND), save, allocatable :: & & wz_Psi_a(:,:) , & ! スペクトル(流線関数) & wz_Chi_a(:,:) ! スペクトル(ポテンシャル) logical, save :: dycore_hs94forcing_initialized = .false. character(STRING),parameter:: version = & & '$Id: dycore_hs94forcing.f90,v 1.1.1.1 2005/11/08 14:10:24 morikawa Exp $' character(STRING),parameter:: tagname = '$Name: dcpam3-20061118 $' contains !=begin !== Procedure Interface ! !=== Initialize module and ! !((< hs94forcing_mod >)) を初期化する。 ! subroutine dycore_hs94forcing_init( Dims ) !==== Dependency use constants_mod , only: constants_init use spml_mod , only: spml_init use dycore_type_mod, only: DYCORE_DIMS use dycore_grid_mod, only: dycore_grid_init, im, jm, km, nm use hs94forcing_mod, only: hs94forcing_init use dc_trace, only: BeginSub, EndSub, DbgMessage !=end implicit none !=begin !==== Input ! type(DYCORE_DIMS), intent(in) :: Dims ! 次元データ全種 !=end !----- 作業用内部変数 ----- character(STRING), parameter:: subname = "dycore_hs94forcing_init" continue !---------------------------------------------------------------- ! Check Initialization !---------------------------------------------------------------- call BeginSub(subname) if (dycore_hs94forcing_initialized) then call EndSub( subname, '%c is already called.', c1=trim(subname) ) return else dycore_hs94forcing_initialized = .true. endif !---------------------------------------------------------------- ! Version identifier !---------------------------------------------------------------- call DbgMessage('%c :: %c', c1=trim(version), c2=trim(tagname)) !----------------------------------------------------------------- ! Initialize Dependent Modules !----------------------------------------------------------------- call constants_init call spml_init call dycore_grid_init call hs94forcing_init( & & Dims%x_Lon , & ! intent(in): 経度座標 & Dims%y_Lat , & ! intent(in): 緯度座標 & Dims%z_Sigma ) ! intent(in): σレベル(整数)座標 !----------------------------------------------------------------- ! Allocate variables !----------------------------------------------------------------- allocate( & & xyz_VelLon_phy(im,jm,km) , & ! 速度経度成分の加熱散逸効果 & xyz_VelLat_phy(im,jm,km) , & ! 速度緯度成分の加熱散逸効果 & xyz_Temp_phy(im,jm,km) ) ! 温度の加熱散逸効果 allocate( wz_Psi_a((nm+1)*(nm+1), km) ) allocate( wz_Chi_a((nm+1)*(nm+1), km) ) call EndSub(subname) end subroutine dycore_hs94forcing_init !=begin !=== Calculate Heating and Dissipation for "Held and Suarez(1994)" ! ! ! subroutine dycore_hs94forcing( Vars_b, Vars_n, Vars_a ) !==== Dependency use dycore_type_mod, only: DYCORE_VARS, & & STRING, DBKIND, INTKIND use dycore_time_mod, only: DelTime use constants_mod , only: R0 use spml_mod , only: xya_wa, wa_Div_xya_xya, & & wa_LaplaInv_wa, wa_xya, & & xya_GradLat_wa, xya_GradLon_wa use hs94forcing_mod, only: hs94forcing use dc_trace , only: BeginSub, EndSub, DbgMessage !=end implicit none !=begin !==== Input ! type(DYCORE_VARS), intent(in) :: Vars_b ! 格子点データ全種 (t-Δt) type(DYCORE_VARS), intent(in) :: Vars_n ! 格子点データ全種 (t) ! !==== Output ! type(DYCORE_VARS), intent(inout):: Vars_a ! 格子点データ全種(t+Δt) !=end character(STRING), parameter:: subname = "dycore_hs94forcing" continue !---------------------------------------------------------------- ! Check Initialization !---------------------------------------------------------------- call BeginSub(subname) if (.not. dycore_hs94forcing_initialized) then call EndSub( subname, 'Call dycore_hs94forcing_init before call %c', & & c1=trim(subname) ) return endif !---------------------------------------------------------------- ! Call hs94forcing !---------------------------------------------------------------- call hs94forcing( & & Vars_b%xyz_VelLon , & ! intent(in): 速度経度成分 (t-Δt) & Vars_b%xyz_VelLat , & ! intent(in): 速度緯度成分 (t-Δt) & Vars_b%xyz_Temp , & ! intent(in): 温度 (t-Δt) & Vars_b%xy_Ps , & ! intent(in): 地表面気圧 (t-Δt) & xyz_VelLon_phy , & ! intent(inout): 速度経度成分の加熱散逸効果 & xyz_VelLat_phy , & ! intent(inout): 速度緯度成分の加熱散逸効果 & xyz_Temp_phy ) ! intent(inout): 温度の加熱散逸効果 !---------------------------------------------------------------- ! Add Heating and Dissipation !---------------------------------------------------------------- Vars_a%xyz_VelLon = Vars_a%xyz_VelLon + 2. * DelTime * xyz_VelLon_phy Vars_a%xyz_VelLat = Vars_a%xyz_VelLat + 2. * DelTime * xyz_VelLat_phy Vars_a%xyz_Temp = Vars_a%xyz_Temp + 2. * DelTime * xyz_Temp_phy !---------------------------------------------------------------- ! Generate Vorticity and Divergence from Velocity !---------------------------------------------------------------- Vars_a%xyz_Vor = & & xya_wa( & & wa_Div_xya_xya( Vars_a%xyz_VelLat , & & - Vars_a%xyz_VelLon & & ) / R0 & & ) Vars_a%xyz_Div = & & xya_wa( & & wa_Div_xya_xya( Vars_a%xyz_VelLon , & & Vars_a%xyz_VelLat & & ) / R0 & & ) !------------------------------------------------------------------- ! Generate Velocity from Vorticity and Divergence !------------------------------------------------------------------- wz_Psi_a = wa_LaplaInv_wa( wa_xya( Vars_a%xyz_Vor ) ) * R0**2 wz_Chi_a = wa_LaplaInv_wa( wa_xya( Vars_a%xyz_Div ) ) * R0**2 Vars_a%xyz_VelLon = ( xya_GradLon_wa( wz_Chi_a ) & & - xya_GradLat_wa( wz_Psi_a ) ) / R0 Vars_a%xyz_VelLat = ( xya_GradLon_wa( wz_Psi_a ) & & + xya_GradLat_wa( wz_Chi_a ) ) / R0 !------------------------------------------------------------------- ! Trancate Temperature !------------------------------------------------------------------- Vars_a%xyz_Temp = xya_wa( wa_xya(Vars_a%xyz_Temp) ) call EndSub(subname) end subroutine dycore_hs94forcing !=begin !=== Terminate module ! !((< hs94forcing_mod >)) の終了処理を行なう。 ! subroutine dycore_hs94forcing_end !==== Dependency use dycore_type_mod, only: STRING, DBKIND, INTKIND use hs94forcing_mod, only: hs94forcing_end use dc_trace, only: BeginSub, EndSub, DbgMessage !=end implicit none !----------------------------------------------------------------- ! 変数定義 !----------------------------------------------------------------- !----- 作業用内部変数 ----- character(STRING), parameter:: subname = "dycore_hs94forcing_end" continue !----------------------------------------------------------------- ! Check Initialization !----------------------------------------------------------------- call BeginSub(subname) if ( .not. dycore_hs94forcing_initialized) then call EndSub( subname, 'dycore_hs94forcing_init was not called', & & c1=trim(subname) ) return else dycore_hs94forcing_initialized = .false. endif !------------------------------------------------------------------- ! Terminate Dependent Modules !------------------------------------------------------------------- call hs94forcing_end call EndSub(subname) end subroutine dycore_hs94forcing_end end module dycore_hs94forcing_mod