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   use module_debug
  18
  19   implicit none
  20   integer :: ndates
  21   character(len=*), dimension(ndates) :: hdates
  22   character(len=*) :: root
  23   integer :: interval
  24
  25   logical :: lexist
  26   integer :: idate
  27   character(len=MAX_FILENAME_LEN) :: flnm
  28
  29 ! DATELEN:  length of date strings to use for our output file names.
  30   integer :: datelen
  31
  32 ! Decide the length of date strings to use for output file names.
  33 ! DATELEN is 13 for hours, 16 for minutes, and 19 for seconds.
  34   if (mod(interval,3600) == 0) then
  35      datelen = 13
  36   else if (mod(interval, 60) == 0) then
  37      datelen = 16
  38   else
  39      datelen = 19
  40   end if
  41
  42   write(*, '(/,10("*"), /, &
  43        &    "Deleting temporary files created by ungrib...",/, &
  44        &    10("*")/)')
  45   call mprintf(.true.,LOGFILE,"****  Deleting temporary files created by ungrib... ")
  46
  47   do idate = 1, ndates
  48      flnm=trim(root)//hdates(idate)(1:datelen)
  49      write(*, '(A)') 'Deleting file:  '//trim(flnm)
  50      call mprintf(.true.,LOGFILE," Deleting file: %s ",s1=trim(flnm))
  51
  52      inquire(file=flnm, exist = lexist)
  53      if (lexist) then
  54         open(10, file=flnm, status='old')
  55         close(10, status="DELETE")
  56      else
  57         write(*,'(10x, "File ",A," does not exist.",/)') flnm
  58         call mprintf(.true.,LOGFILE," File  %s does not exist ",s1=flnm)
  59      endif
  60   enddo
  61
  62   write(*, '(/,10("*"), /, &
  63        &    "Done deleting temporary files.",/, &
  64        &    10("*")/)')
  65   call mprintf(.true.,LOGFILE,"****  Done deleting temporary files. ")
  66
  67 end subroutine file_delete