Class modify_albedo_snowseaice
In: surface_properties/modify_albedo_snowseaice.f90

Methods

Included Modules

dc_types dc_message gridset axesset constants_snowseaice

Public Instance methods

Subroutine :
xy_SurfCond( 0:imax-1, 1:jmax ) :integer , intent(in )
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_SurfAlbedo( 0:imax-1, 1:jmax ) :real(DP), intent(inout)

[Source]

  subroutine ModAlbedoDueToSnowSeaIce( xy_SurfCond, xy_SurfMajCompIce, xy_SurfSnow, xy_SeaIceConc, xy_SurfAlbedo )

    ! 格子点設定
    ! Grid points settings
    !
    use gridset, only: imax, jmax, kmax    ! 鉛直層数.
                               ! Number of vertical level

    ! 座標データ設定
    ! Axes data settings
    !
    use axesset, only: y_Lat

    ! 雪と海氷の定数の設定
    ! Setting constants of snow and sea ice
    !
    use constants_snowseaice, only: SnowThreshold => ThresholdSurfSnow, SnowAlbedo, SeaIceThreshold, SeaIceAlbedo, CO2IceThreshold, CO2IceAlbedoS, CO2IceAlbedoN


    integer , intent(in   )           :: xy_SurfCond      ( 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(inout)           :: xy_SurfAlbedo    ( 0:imax-1, 1:jmax )


    ! 作業変数
    ! Work variables
    !
    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_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_SurfCond(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


    if ( present( xy_SurfSnow ) ) then
      ! modify surface albedo on the snow covered ground
      !
      do j = 1, jmax
        do i = 0, imax-1

!!$          if ( xy_SurfCond(i,j) > 0 .and. xy_SurfSnow(i,j) > SnowThreshold ) then
!!$            xy_SurfAlbedo(i,j) = SnowAlbedo
!!$          end if
!!$
          if ( xy_SurfCond(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
          end if

        end do
      end do

    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_SurfCond(i,j) == 0 .and. xy_SeaIceConc(i,j) > SeaIceThreshold ) then
            xy_SurfAlbedo(i,j) = SeaIceAlbedo
          end if

!!$          if ( xy_SurfCond(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


  end subroutine ModAlbedoDueToSnowSeaIce
Subroutine :

[Source]

  subroutine ModAlbedoSnowSeaIceInit

    if ( modify_albedo_snowseaice_inited ) return


    ! 印字 ; Print
    !
    call MessageNotify( 'M', module_name, '----- Initialization Messages -----' )
    call MessageNotify( 'M', module_name, '-- version = %c', c1 = trim(version) )


    modify_albedo_snowseaice_inited = .true.

  end subroutine ModAlbedoSnowSeaIceInit

Private Instance methods

modify_albedo_snowseaice_inited
Variable :
modify_albedo_snowseaice_inited = .false. :logical, save
: 初期設定フラグ. Initialization flag
module_name
Constant :
module_name = ‘modify_albedo_snowseaice :character(*), parameter
: モジュールの名称. Module name
version
Constant :
version = ’$Name: dcpam5-20120813-2 $’ // ’$Id: modify_albedo_snowseaice.f90,v 1.4 2012-01-20 00:16:41 yot Exp $’ :character(*), parameter
: モジュールのバージョン Module version