Skip to content
Snippets Groups Projects
write_eddy.f90 3.31 KiB
module write_eddy_m
  
    implicit none

contains

  subroutine write_eddy(e, hshp, k, i)

    use, intrinsic:: ieee_arithmetic, only: ieee_is_nan

    ! Libraries:
    use nr_util, only: pi, rad_to_deg
    use shapelib, only: shpt_polygon
    use shapelib_03, only: shp_append_point_03, dbf_write_attribute_03, &
         shp_append_object_03, shp_append_null_03

    use derived_types, only: eddy, missing_speed, shp_tr

    type(eddy), intent(in):: e
    TYPE(shp_tr), intent(in):: hshp
    integer, intent(in):: k ! date index
    integer, intent(in):: i ! eddy index

    ! Local:
    integer ishape

    !-------------------------------------------------------------

    call shp_append_point_03(ishape, hshp%extremum, e%coord_extr * rad_to_deg)

    call dbf_write_attribute_03(hshp%extremum, ishape, hshp%extr_ssh, &
         e%ssh_extr)
    call dbf_write_attribute_03(hshp%extremum, ishape, hshp%extr_date, k)
    call dbf_write_attribute_03(hshp%extremum, ishape, hshp%extr_eddy_index, i)
    call dbf_write_attribute_03(hshp%extremum, ishape, hshp%extr_interp, &
         merge(1, 0, e%interpolated))
    call dbf_write_attribute_03(hshp%extremum, ishape, hshp%extr_cycl, &
         merge(1, 0, e%cyclone))
    call dbf_write_attribute_03(hshp%extremum, ishape, hshp%extr_valid, &
         merge(1, 0, e%valid))

    if (ieee_is_nan(e%max_speed)) then
       call dbf_write_attribute_03(hshp%extremum, ishape, hshp%extr_speed, &
            missing_speed)
       ! (Cannot write NaN to dbf file.)
    else
       call dbf_write_attribute_03(hshp%extremum, ishape, hshp%extr_speed, &
            e%max_speed)
    end if

    if (e%out_cont%n_points == 0) then
       call shp_append_null_03(ishape, hshp%outermost)
    else
       call shp_append_object_03(ishape, hshp%outermost, shpt_polygon, &
            e%out_cont%points * rad_to_deg)
    end if

    if (e%speed_cont%n_points == 0) then
       call shp_append_null_03(ishape, hshp%max_speed)
    else
       call shp_append_object_03(ishape, hshp%max_speed, shpt_polygon, &
            e%speed_cont%points * rad_to_deg)
    end if

    if (e%out_cont%area >= 0) then
       call dbf_write_attribute_03(hshp%outermost, ishape, &
            hshp%out_r_eq_area, sqrt(e%out_cont%area / 1e6 / pi))
    else
       call dbf_write_attribute_03(hshp%outermost, ishape, &
            hshp%out_r_eq_area, - 100.)
    end if

    call dbf_write_attribute_03(hshp%outermost, ishape, hshp%out_ssh, &
         e%out_cont%ssh)
    call dbf_write_attribute_03(hshp%outermost, ishape, hshp%out_date, k)
    call dbf_write_attribute_03(hshp%outermost, ishape, hshp%out_eddy_index, &
         i)
    call dbf_write_attribute_03(hshp%outermost, ishape, hshp%out_radius4, &
         e%radius4)

    if (e%speed_cont%area >= 0) then
       call dbf_write_attribute_03(hshp%max_speed, ishape, &
            hshp%max_speed_r_eq_area, sqrt(e%speed_cont%area / 1e6 / pi))
    else
       call dbf_write_attribute_03(hshp%max_speed, ishape, &
            hshp%max_speed_r_eq_area, - 100.)
    end if

    call dbf_write_attribute_03(hshp%max_speed, ishape, hshp%max_speed_ssh, &
         e%speed_cont%ssh)
    call dbf_write_attribute_03(hshp%max_speed, ishape, hshp%max_speed_date, &
         k)
    call dbf_write_attribute_03(hshp%max_speed, ishape, &
         hshp%max_speed_eddy_index, i)

  end subroutine write_eddy

end module write_eddy_m