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

contains

  subroutine write_eddy(e, hshpc, date, i)

    ! We assume and do not check that e%out_cont is not null (and
    ! therefore e%out_cont%area >= 0).

    ! Libraries:
    use jumble, only: pi, rad_to_deg, assert
    use shapelib, only: shpt_polygon, shpfileisnull
    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, shpc_slice_handler

    type(eddy), intent(in):: e
    TYPE(shpc_slice_handler), intent(in):: hshpc
    integer, intent(in):: date
    integer, intent(in):: i ! eddy index

    ! Local:
    integer ishape

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

    call assert(hshpc%cyclone .eqv. e%cyclone, &
         "write_eddy: orientation mismatch")
    call shp_append_point_03(ishape, hshpc%extremum, e%extr%coord * rad_to_deg)

    ! extremum.dbf:
    call dbf_write_attribute_03(hshpc%extremum, ishape, hshpc%extr_ssh, &
         e%extr%ssh)
    call dbf_write_attribute_03(hshpc%extremum, ishape, hshpc%extr_date, date)
    call dbf_write_attribute_03(hshpc%extremum, ishape, hshpc%extr_eddy_index, &
         i)
    call dbf_write_attribute_03(hshpc%extremum, ishape, hshpc%extr_speed, &
            e%max_speed)

    if (.not. shpfileisnull(hshpc%extr_proj)) then
       call shp_append_point_03(ishape, hshpc%extr_proj, &
            real(e%extr%coord_proj))

       ! extr_proj.dbf:
       call dbf_write_attribute_03(hshpc%extr_proj, ishape, &
            hshpc%extr_proj_date, date)
       call dbf_write_attribute_03(hshpc%extr_proj, ishape, &
            hshpc%extr_proj_eddy_index, i)
    end if

    call shp_append_object_03(ishape, hshpc%outermost, shpt_polygon, &
         e%out_cont%points * rad_to_deg)

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

    ! outermost_contour.dbf:
    call dbf_write_attribute_03(hshpc%outermost, ishape, &
         hshpc%out_r_eq_area, sqrt(e%out_cont%area / 1e6 / pi))
    call dbf_write_attribute_03(hshpc%outermost, ishape, hshpc%out_ssh, &
         e%out_cont%ssh)
    call dbf_write_attribute_03(hshpc%outermost, ishape, hshpc%out_date, date)
    call dbf_write_attribute_03(hshpc%outermost, ishape, hshpc%out_eddy_index, &
         i)

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

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

  end subroutine write_eddy

end module write_eddy_m