module tcv_mod
!$$$ module documentation block
! . . . .
! module: tcv_mod
!
! prgmmr: kleist org: np23 date: 2009-02-02
!
! abstract: This module contains variables and subroutines to read the
! TC Vitals file correctly
!
! program history log:
! 2009-02-02 kleist
! 2010-09-08 treadon - add centerid and destroy_tcv_card; code cleanup
!
! Subroutines Included:
! sub get_storminfo - loads storm data structure from tc vitals info
! sub read_tcv_card - read data structure from tc vitals ascii file
! sub destroy_tcv_card - deallocate arrays containing storm information
! sub init_tcps_errvals - initialize values for tcps ob error
!
! Variable Definitions:
! def numstorms - number of storms in tc vitals file
! def stormswitch - integer switch to turn on reading of individual storms
! def stormid - storm character identifier
! def stormlat - storm latitude
! def stormlon - storm longitude
! def stormpsmin - storm sea level pressure minimum
! def stormdattim - storm dat/time
! def centerid - organization (center) id
! def stormid - storm id with basin identifier
! def tcp_refps - reference pressure for tcps oberr calculation (mb)
! def tcp_width - parameter for tcps oberr inflation (width, mb)
! def tcp_ermin - parameter for tcps oberr inflation (minimum oberr, mb)
! def tcp_ermax - parameter for tcps oberr inflation (maximum oberr, mb)
!
! attributes:
! language: f90
! machine: ibm RS/6000 SP
!
!$$$ end documentation block
use kinds, only: r_kind,i_kind
implicit none
! set default to private
private
! set subroutines to public
public :: get_storminfo
public :: read_tcv_card
public :: destroy_tcv_card
public :: init_tcps_errvals
! set passed variables to public
public :: stormpsmin,stormdattim,stormlon,numstorms,stormlat,centerid,stormid
public :: tcvcard
public :: tcp_refps,tcp_width,tcp_ermin,tcp_ermax
integer(i_kind) numstorms
integer(i_kind),dimension(:),allocatable:: stormswitch
character(len=3),dimension(:),allocatable:: stormid
character(len=4),dimension(:),allocatable:: centerid
real(r_kind),dimension(:),allocatable:: stormlat,stormlon,stormpsmin
integer(i_kind),dimension(:),allocatable:: stormdattim
real(r_kind) tcp_refps,tcp_width,tcp_ermin,tcp_ermax
type:: tcvcard ! Define a new type for a TC Vitals card
character*4 :: tcv_center ! Hurricane Center Acronym
character*3 :: tcv_storm_id ! Storm Identifier (03L, etc)
character*9 :: tcv_storm_name ! Storm name
integer(i_kind):: tcv_century ! 2-digit century id (19 or 20)
integer(i_kind):: tcv_yymmdd ! Date of observation
integer(i_kind):: tcv_hhmm ! Time of observation (UTC)
integer(i_kind):: tcv_lat ! Storm Lat (*10), always >0
character*1 :: tcv_latns ! 'N' or 'S'
integer(i_kind):: tcv_lon ! Storm Lon (*10), always >0
character*1 :: tcv_lonew ! 'E' or 'W'
integer(i_kind):: tcv_stdir ! Storm motion vector (in degr)
integer(i_kind):: tcv_stspd ! Spd of storm movement (m/s*10)
integer(i_kind):: tcv_pcen ! Min central pressure (mb)
integer(i_kind):: tcv_penv ! val outrmost closed isobar(mb)
integer(i_kind):: tcv_penvrad ! rad outrmost closed isobar(km)
integer(i_kind):: tcv_vmax ! max sfc wind speed (m/s)
integer(i_kind):: tcv_vmaxrad ! rad of max sfc wind spd (km)
integer(i_kind):: tcv_r15ne ! NE rad of 15 m/s winds (km)
integer(i_kind):: tcv_r15se ! SE rad of 15 m/s winds (km)
integer(i_kind):: tcv_r15sw ! SW rad of 15 m/s winds (km)
integer(i_kind):: tcv_r15nw ! NW rad of 15 m/s winds (km)
character*1 :: tcv_depth ! Storm depth (S,M,D) X=missing
end type tcvcard
contains
subroutine get_storminfo(lunin)
!$$$ subprogram documentation block
! . . . .
! subprogram: get_storminfo load tc storm information arrays
!
! prgmmr: kleist org: np23 date: 2009-02-02
!
! abstract: loads the tropical storm arrays necessary for the assim.
! of synthetic tc-mslp observations
!
! program history log:
! 2009-02-02 kleist
!
! input argument list:
! lunin - integer unit from which to read tc-vitals ascii data
!
! attributes:
! language: f90
! machine: ibm RS/6000 SP
!
!$$$
implicit none
integer(i_kind),intent(in ) :: lunin
integer(i_kind) iret,lucard,ii
type(tcvcard) stormtmp
type(tcvcard),dimension(:),allocatable:: storminfo
lucard=lunin
! Find number of storms in tcvitals file
rewind(lucard)
ii=0
do while (.true.)
read (lucard,21,END=801,ERR=891) stormtmp
ii = ii + 1
enddo
801 continue
!
21 format (a4,1x,a3,1x,a9,1x,i2,i6,1x,i4,1x,i3,a1,1x,i4,a1,1x,i3,1x, &
i3,3(1x,i4),1x,i2,1x,i3,1x,4(i4,1x),a1)
numstorms=ii
! Allocate arrays
allocate(stormswitch(numstorms),stormid(numstorms),centerid(numstorms))
allocate(stormlat(numstorms),stormlon(numstorms),stormpsmin(numstorms))
allocate(storminfo(numstorms))
allocate(stormdattim(numstorms))
stormswitch=1
call read_tcv_card(numstorms,storminfo,lucard,stormswitch,stormlon,stormlat,&
centerid,stormid,stormpsmin,stormdattim,iret)
deallocate(storminfo)
if (numstorms>0) then
iret = 0
return
else
write(6,*)'GET_STORMINFO: ***ERROR*** num storms to be processed <= 0'
write(6,*)'GET_STORMINFO: Check file assigned to unit lucard=',lucard
iret = 99
return
endif
891 write(6,*)'GET_STORMINFO: ***ERROR*** in reading unit luncard=',lucard
iret = 98
return
end subroutine get_storminfo
subroutine read_tcv_card(nums,storm,lucard,stswitch,slonfg,slatfg,centerid,stid,stpsmin,stdattim,iret)
!$$$ subprogram documentation block
! . . . .
! subprogram: get_storminfo load tc storm information arrays
!
! prgmmr: kleist org: np23 date: 2009-02-02
!
! abstract: Reads the tcvitals file for current time and loads necessary
! storm arrays.
!
! program history log:
! 2009-02-02 kleist
! 2010-03-30 treadon - loop tcvitals read from 1 to nums
!
! input argument list:
! nums - integer number of storms to read
! stswitch - integer switch to determine whether or not to read in
! lucard - integer identifying input file to read from
!
! output argument list:
! storm - array containing data structure with tc vitals info
! slonfg - storm longitudes
! slatfg - storm latitudes
! centerid - organization (center) id
! stid - storm id
! stpsmin - storm minimum sea level pressure (mb)
! stdattim - storm date and time
! iret - integer return flag
!
! attributes:
! language: f90
! machine: ibm RS/6000 SP
!
!$$$
use constants, only: zero,one
implicit none
integer(i_kind) ,intent(in ) :: nums,lucard
integer(i_kind) ,dimension(nums),intent(in ) :: stswitch
type(tcvcard) ,dimension(nums),intent( out) :: storm
character(len=4),dimension(nums),intent( out) :: centerid
character(len=3),dimension(nums),intent( out) :: stid
real(r_kind) ,dimension(nums),intent( out) :: slonfg,slatfg,stpsmin
integer(i_kind) ,dimension(nums),intent( out) :: stdattim
integer(i_kind) ,intent( out) :: iret
integer(i_kind) ict,i,ii
slonfg = zero; slatfg = zero
!
rewind(lucard)
do ii=1,nums
read (lucard,21,END=901,ERR=991) storm(ii)
enddo
901 continue
!
21 format (a4,1x,a3,1x,a9,1x,i2,i6,1x,i4,1x,i3,a1,1x,i4,a1,1x,i3,1x, &
i3,3(1x,i4),1x,i2,1x,i3,1x,4(i4,1x),a1)
!
write(6,*)'READ_TCV_CARD: Following are the storms to be processed: '
ict=0
do i=1,nums
if (stswitch(i)==1) then
ict = ict + 1
write (6,31) storm(i)
if (storm(i)%tcv_lonew == 'W') then
slonfg(i) = 360._r_kind - float(storm(i)%tcv_lon)/10.0_r_kind
else
slonfg(i) = float(storm(i)%tcv_lon)/10.0_r_kind
endif
if (storm(i)%tcv_latns == 'S') then
slatfg(i) = -one * float(storm(i)%tcv_lat)/10.0_r_kind
else
slatfg(i) = float(storm(i)%tcv_lat)/10.0_r_kind
endif
centerid(i) = storm(i)%tcv_center
stid(i) = storm(i)%tcv_storm_id
stpsmin(i) = storm(i)%tcv_pcen
stdattim(i) = 100000000*storm(i)%tcv_century + 100*storm(i)%tcv_yymmdd + storm(i)%tcv_hhmm/100
endif
write(6,*)'READ_TCV_CARD: STORM #, STID,LAT, LON, MINSLP = ',i,stid(i),slatfg(i),slonfg(i),stpsmin(i)
write(6,*)'READ_TCV_CARD: STORM DATTIM = ',stdattim(i)
enddo
31 format (1x,a4,1x,a3,1x,a9,1x,i2,i6.6,1x,i4.4,1x,i3,a1,1x,i4,a1,1x,i3, &
1x,i3,3(1x,i4),1x,i2,1x,i3,1x,4(i4,1x),a1)
if (ict>0) then
iret = 0
return
else
write(6,*)'READ_TCV_CARD: ***ERROR*** num storms to be processed <=0 '
write(6,*)'READ_TCV_CARD: Check file assigned to unit lucard=',lucard
iret = 99
return
endif
!
991 write(6,*)'READ_TCV_CARD: ***ERROR*** in read_tcv_card reading unit lucard=',lucard
iret = 98
!
write(6,*) 'END OF READ_TCV_CARD: number of storms to process = ',nums
return
end subroutine read_tcv_card
subroutine destroy_tcv_card
!$$$ subprogram documentation block
! . . . .
! subprogram: destroy_tcv_card deallocate storm information arrays
!
! prgmmr: treadon org: np23 date: 2010-09-08
!
! abstract: Deallocate storm information arrays.
!
! program history log:
! 2010-09-08 treadon
!
! input argument list:
!
! attributes:
! language: f90
! machine: ibm RS/6000 SP
!
!$$$
implicit none
deallocate(stormswitch,stormid,centerid)
deallocate(stormlat,stormlon,stormpsmin)
deallocate(stormdattim)
end subroutine destroy_tcv_card
subroutine init_tcps_errvals
!$$$ subprogram documentation block
! . . . .
! subprogram: init_tcps_errvals initialize parm values
!
! prgmmr: kleist org: np23 date: 2010-09-14
!
! abstract: Initialize parameter values for specification of tcps ob error
!
! program history log:
! 2010-09-14 kleist
!
! input argument list:
!
! attributes:
! language: f90
! machine: ibm RS/6000 SP
!
!$$$
implicit none
! note: all values in mb
tcp_refps=1000.0_r_kind
tcp_width=50.0_r_kind
tcp_ermin=0.75_r_kind
tcp_ermax=5.0_r_kind
end subroutine init_tcps_errvals
end module tcv_mod