ungrib/src/file_delete.F

   1 subroutine file_delete(hdates, ndates, root, interval)
   2 ! Recent changes:                                                             !
   3 !    2001-02-14:                                                              !
   4 !               - Allow file names to have date stamps out to minutes or      !
   5 !                 seconds, if the user requests a time interval (in seconds)  !
   6 !                 that is evenly divisible into minutes or hours.             !
   7 !                 INTERVAL is checked for divisibility into 3600 (for hours)  !
   8 !                 or 60 (for minutes).  The local variable DATELEN is set     !
   9 !                 to be the number of characters to use in our character      !
  10 !                 dates.  Valid values for DATELEN are 13 (for hours),        !
  11 !                 16 (for minutes), and 19 (for seconds).                     !
  12 !                                                                             !
  13 !                 This change also requires changes to pregrid_grib.F,        !
  14 !                 output.F, rrpr.F, datint.F                                  !
  15
  16   use misc_definitions_module
  17
  18   implicit none
  19   integer :: ndates
  20   character(len=*), dimension(ndates) :: hdates
  21   character(len=*) :: root
  22   integer :: interval
  23
  24   logical :: lexist
  25   integer :: idate
  26   character(len=MAX_FILENAME_LEN) :: flnm
  27
  28 ! DATELEN:  length of date strings to use for our output file names.
  29   integer :: datelen
  30
  31 ! Decide the length of date strings to use for output file names.
  32 ! DATELEN is 13 for hours, 16 for minutes, and 19 for seconds.
  33   if (mod(interval,3600) == 0) then
  34      datelen = 13
  35   else if (mod(interval, 60) == 0) then
  36      datelen = 16
  37   else
  38      datelen = 19
  39   end if
  40
  41   write(*, '(/,10("*"), /, &
  42        &    "Deleting temporary files created by ungrib...",/, &
  43        &    10("*")/)')
  44
  45   do idate = 1, ndates
  46      flnm=trim(root)//hdates(idate)(1:datelen)
  47      write(*, '(A)') 'Deleting file:  '//trim(flnm)
  48
  49      inquire(file=flnm, exist = lexist)
  50      if (lexist) then
  51         open(10, file=flnm, status='old')
  52         close(10, status="DELETE")
  53      else
  54         write(*,'(10x, "File ",A," does not exist.",/)') flnm
  55      endif
  56   enddo
  57
  58   write(*, '(/,10("*"), /, &
  59        &    "Done deleting temporary files.",/, &
  60        &    10("*")/)')
  61
  62 end subroutine file_delete