!= 雪と海氷によるアルベド変化 ! != modification of surface albedo on the snow covered ground and on the sea ice ! ! Authors:: Yoshiyuki O. Takahashi, Shin-ichi Takehiro ! Version:: $Id: modify_albedo_snowseaice.f90,v 1.6 2025/09/17 22:00:00 takepiro Exp $ ! Tag Name:: $Name: $ ! Copyright:: Copyright (C) GFD Dennou Club, 2008-2025. All rights reserved. ! License:: See COPYRIGHT[link:../../../COPYRIGHT] ! module modify_albedo_snowseaice ! モジュール引用 ; USE statements ! ! 種別型パラメタ ! Kind type parameter ! use dc_types, only: DP, & ! 倍精度実数型. Double precision. & STRING ! 文字列. Strings. ! メッセージ出力 ! Message output ! use dc_message, only: MessageNotify ! 格子点設定 ! Grid points settings ! 宣言文 ; Declaration statements ! implicit none private ! 公開手続き ! Public procedure ! public :: ModAlbedoDueToSnowSeaIce public :: ModAlbedoSnowSeaIceInit ! 公開変数 ! Public variables ! ! 非公開変数 ! Private variables ! logical, save :: FlagModAlbedoBasedOnTemp logical, save :: modify_albedo_snowseaice_inited = .false. ! 初期設定フラグ. ! Initialization flag character(*), parameter:: module_name = 'modify_albedo_snowseaice' ! モジュールの名称. ! Module name character(*), parameter:: version = & & '$Name: $' // & & '$Id: modify_albedo_snowseaice.f90,v 1.6 2025/09/17 22:00:00 takepiro Exp $' ! モジュールのバージョン ! Module version contains !-------------------------------------------------------------------------------------- subroutine ModAlbedoDueToSnowSeaIce( & & xy_SurfType, & & xy_SurfMajCompIce, xy_SurfSnow, xy_SeaIceConc, xy_SOSeaIceMass, & ! (in ) optional & xy_SurfTemp, & ! (in ) optional & xy_SurfAlbedo & ! (inout) ) ! モジュール引用 ; 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 ! 座標データ設定 ! Axes data settings ! use axesset, only: y_Lat ! 雪と海氷の定数の設定 ! Setting constants of snow and sea ice ! use constants_snowseaice, only: & & SnowAlbedo, & & SeaIceAlbedo, & & SOSeaIceThresholdMass, & & CO2IceThreshold, & & CO2IceAlbedoS, & & CO2IceAlbedoN, & & TempBelowSeaIce ! 雪, 氷の割合 ! snow/ice fraction ! use snowice_frac, only : CalcSnowFrac ! 雪, 氷の割合 ! snow/ice fraction ! use snowice_frac, only : SeaIceAboveThreshold integer , intent(in ) :: xy_SurfType ( 0:imax-1, 1:jmax ) real(DP), intent(in ), optional :: xy_SurfMajCompIce( 0:imax-1, 1:jmax ) real(DP), intent(in ), optional :: xy_SurfSnow ( 0:imax-1, 1:jmax ) real(DP), intent(in ), optional :: xy_SeaIceConc ( 0:imax-1, 1:jmax ) real(DP), intent(in ), optional :: xy_SOSeaIceMass ( 0:imax-1, 1:jmax ) real(DP), intent(in ), optional :: xy_SurfTemp ( 0:imax-1, 1:jmax ) real(DP), intent(inout) :: xy_SurfAlbedo ( 0:imax-1, 1:jmax ) ! 作業変数 ! Work variables ! real(DP):: xy_SnowFrac(0:imax-1, 1:jmax) real(DP):: MajCompIceThreshold real(DP):: MajCompIceAlbedo integer:: i ! 経度方向に回る DO ループ用作業変数 ! Work variables for DO loop in longitude integer:: j ! 緯度方向に回る DO ループ用作業変数 ! Work variables for DO loop in latitude ! 初期化確認 ! Initialization check ! if ( .not. modify_albedo_snowseaice_inited ) then call MessageNotify( 'E', module_name, 'This module has not been initialized.' ) end if if ( present( xy_SeaIceConc ) ) then ! modify surface albedo on the sea ice ! do j = 1, jmax do i = 0, imax-1 if ( ( xy_SurfType(i,j) == 0 ) .and. & & SeaIceAboveThreshold( xy_SeaIceConc(i,j) ) ) then xy_SurfAlbedo(i,j) = SeaIceAlbedo end if !!$ if ( xy_SurfType(i,j) == 0 ) then !!$ if ( xy_SeaIceConc(i,j) > 1.0_DP ) then !!$! call MessageNotify( 'E', module_name, & !!$! & 'The value of SeaIceConc is inappropriate, %f.', & !!$! & d = (/ xy_SeaIceConc(i,j) / ) ) !!$ xy_SurfAlbedo(i,j) = SeaIceAlbedo !!$ else if ( xy_SeaIceConc(i,j) < 0.0_DP ) then !!$! call MessageNotify( 'E', module_name, & !!$! & 'The value of SeaIceConc is inappropriate, %f.', & !!$! & d = (/ xy_SeaIceConc(i,j) / ) ) !!$ xy_SurfAlbedo(i,j) = xy_SurfAlbedo(i,j) !!$ else !!$ xy_SurfAlbedo(i,j) = & !!$ & ( SeaIceAlbedo - xy_SurfAlbedo(i,j) ) / ( 1.0_DP - 0.0_DP ) & !!$ & * ( xy_SeaIceConc(i,j) - 0.0_DP ) & !!$ & + xy_SurfAlbedo(i,j) !!$ end if !!$ end if end do end do end if if ( present( xy_SOSeaIceMass ) ) then ! modify surface albedo on slab sea ice ! do j = 1, jmax do i = 0, imax-1 if ( xy_SurfType(i,j) == 0 ) then if ( xy_SOSeaIceMass(i,j) >= SOSeaIceThresholdMass ) then xy_SurfAlbedo(i,j) = SeaIceAlbedo end if end if end do end do end if if ( FlagModAlbedoBasedOnTemp ) then ! modify surface albedo on slab sea ice dependent on temperature ! if ( .not. present( xy_SurfTemp ) ) then call MessageNotify( 'E', module_name, & & ' xy_SurfTemp has to be included arguments when FlagModAlbedoBaseOnTemp is true.' ) end if do j = 1, jmax do i = 0, imax-1 if ( xy_SurfType(i,j) == 0 ) then if ( xy_SurfTemp(i,j) <= TempBelowSeaIce ) then xy_SurfAlbedo(i,j) = SeaIceAlbedo end if end if end do end do end if if ( present( xy_SurfSnow ) ) then ! 雪, 氷の割合 ! snow/ice fraction ! call CalcSnowFrac( & !!$ & xy_FlagLand, xy_SurfSnow, & ! (in ) & xy_SurfSnow, & ! (in ) & xy_SnowFrac & ! (out) & ) ! modify surface albedo on the snow covered ground ! do j = 1, jmax do i = 0, imax-1 !!$ if ( xy_SurfType(i,j) > 0 .and. xy_SurfSnow(i,j) > SnowThreshold ) then !!$ xy_SurfAlbedo(i,j) = SnowAlbedo !!$ end if !!$ if ( xy_SurfType(i,j) > 0 ) then !!$ if ( xy_SurfSnow(i,j) > SnowThreshold ) then !!$ xy_SurfAlbedo(i,j) = SnowAlbedo !!$ else if ( xy_SurfSnow(i,j) < 0.0_DP ) then !!$ xy_SurfAlbedo(i,j) = xy_SurfAlbedo(i,j) !!$ else !!$ xy_SurfAlbedo(i,j) = & !!$ & ( SnowAlbedo - xy_SurfAlbedo(i,j) ) / ( SnowThreshold - 0.0_DP ) & !!$ & * ( xy_SurfSnow(i,j) - 0.0_DP ) & !!$ & + xy_SurfAlbedo(i,j) !!$ end if xy_SurfAlbedo(i,j) = & & ( 1.0_DP - xy_SnowFrac(i,j) ) * xy_SurfAlbedo(i,j) & & + xy_SnowFrac(i,j) * SnowAlbedo end if end do end do end if if ( present( xy_SurfMajCompIce ) ) then ! modify surface albedo on the major component ice covered ground ! MajCompIceThreshold = CO2IceThreshold do j = 1, jmax if ( y_Lat(j) < 0.0_DP ) then MajCompIceAlbedo = CO2IceAlbedoS else MajCompIceAlbedo = CO2IceAlbedoN end if do i = 0, imax-1 !!$ if ( xy_SurfCond(i,j) > 0 .and. xy_SurfMajCompIce(i,j) > MajCompIceThreshold ) then !!$ xy_SurfAlbedo(i,j) = MajCompIceAlbedo !!$ end if if ( xy_SurfType(i,j) > 0 ) then if ( xy_SurfMajCompIce(i,j) > MajCompIceThreshold ) then xy_SurfAlbedo(i,j) = MajCompIceAlbedo else if ( xy_SurfMajCompIce(i,j) < 0.0_DP ) then xy_SurfAlbedo(i,j) = xy_SurfAlbedo(i,j) else xy_SurfAlbedo(i,j) = & & ( MajCompIceAlbedo - xy_SurfAlbedo(i,j) ) / ( MajCompIceThreshold - 0.0_DP ) & & * ( xy_SurfMajCompIce(i,j) - 0.0_DP ) & & + xy_SurfAlbedo(i,j) end if end if end do end do end if end subroutine ModAlbedoDueToSnowSeaIce !-------------------------------------------------------------------------------------- subroutine ModAlbedoSnowSeaIceInit ! モジュール引用 ; USE statements ! ! NAMELIST ファイル入力に関するユーティリティ ! Utilities for NAMELIST file input ! use namelist_util, only: namelist_filename, NmlutilMsg ! ファイル入出力補助 ! File I/O support ! use dc_iounit, only: FileOpen ! 種別型パラメタ ! Kind type parameter ! use dc_types, only: STDOUT ! 標準出力の装置番号. Unit number of standard output ! メッセージ出力 ! Message output ! use dc_message, only: MessageNotify ! 雪, 氷の割合 ! snow/ice fraction ! use snowice_frac, only : SnowIceFracInit ! メッセージ制御 ! Message control ! use mpi_messagecntl, only : DoesOutputMPIMessage ! 宣言文 ; Declaration statements ! implicit none integer:: unit_nml ! NAMELIST ファイルオープン用装置番号. ! Unit number for NAMELIST file open integer:: iostat_nml ! NAMELIST 読み込み時の IOSTAT. ! IOSTAT of NAMELIST read ! NAMELIST 変数群 ! NAMELIST group name ! namelist /modify_albedo_snowseaice_nml/ & & FlagModAlbedoBasedOnTemp ! ! デフォルト値については初期化手続 "modify_albedo_snowseaice#ModAlbedoSnowSeaIceInit" ! のソースコードを参照のこと. ! ! Refer to source codes in the initialization procedure ! "modify_albedo_snowseaice#ModAlbedoSnowSeaIceInit" for the default values. ! ! 実行文 ; Executable statement ! if ( modify_albedo_snowseaice_inited ) return ! デフォルト値の設定 ! Default values settings ! FlagModAlbedoBasedOnTemp = .false. ! NAMELIST からの入力 ! Input from NAMELIST ! if ( trim(namelist_filename) /= '' ) then call FileOpen( unit_nml, & ! (out) & namelist_filename, mode = 'r' ) ! (in) rewind( unit_nml ) read( unit_nml, & ! (in) & nml = modify_albedo_snowseaice_nml, & ! (out) & iostat = iostat_nml ) ! (out) close( unit_nml ) call NmlutilMsg( iostat_nml, module_name ) ! (in) if ( iostat_nml == 0 .AND. DoesOutputMPIMessage() ) write( STDOUT, nml = modify_albedo_snowseaice_nml ) end if ! 雪, 氷の割合 ! snow/ice fraction ! call SnowIceFracInit ! 印字 ; Print ! call MessageNotify( 'M', module_name, '----- Initialization Messages -----' ) call MessageNotify( 'M', module_name, ' FlagModAlbedoBaseOnTemp = %b', l = (/ FlagModAlbedoBasedOnTemp /) ) call MessageNotify( 'M', module_name, '-- version = %c', c1 = trim(version) ) modify_albedo_snowseaice_inited = .true. end subroutine ModAlbedoSnowSeaIceInit !-------------------------------------------------------------------------------------- end module modify_albedo_snowseaice