wrfv2_fire/share/module_get_file_names.F

   1 MODULE module_get_file_names
   2
   3 !  This module is used by the ndown program.  We can have multiple output
   4 !  files generated from the wrf program.  To remove the  what-are-the-
   5 !  files-to-input-to-ndown task from the user, we use a couple of UNIX
   6 !  commands.  These are activated from either the "system" command or
   7 !  the "exec" command.  Neither is part of the Fortran standard.
   8
   9    INTEGER :: number_of_eligible_files
  10    CHARACTER(LEN=132) , DIMENSION(:) , ALLOCATABLE :: eligible_file_name
  11
  12 CONTAINS
  13
  14 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  15 #ifdef crayx1
  16    SUBROUTINE system(cmd)
  17       IMPLICIT NONE
  18       CHARACTER (LEN=*) , INTENT(IN) :: cmd
  19       integer :: ierr
  20       call pxfsystem(cmd, len(cmd), ierr)
  21    RETURN
  22    END SUBROUTINE system
  23 #endif
  24
  25    SUBROUTINE unix_ls ( root , id )
  26 !     USE module_dm
  27
  28       IMPLICIT NONE
  29
  30       CHARACTER (LEN=*) , INTENT(IN) :: root
  31       INTEGER , INTENT(IN) :: id
  32
  33       CHARACTER (LEN=132) :: command
  34       INTEGER :: ierr , loop , loslen , strlen
  35 #ifdef NONSTANDARD_SYSTEM_FUNC
  36       INTEGER , EXTERNAL :: SYSTEM
  37 #endif
  38       LOGICAL :: unix_access_ok
  39       LOGICAL, EXTERNAL :: wrf_dm_on_monitor
  40       CHARACTER*256 message
  41
  42       !  This is to make sure that we successfully use one of the available methods
  43       !  for getting at a UNIX command.  This is an initialized flag.
  44
  45       unix_access_ok = .FALSE.
  46
  47       !  Build a UNIX command, and "ls", of all of the files mnatching the "root*" prefix.
  48
  49       monitor_only_code : IF ( wrf_dm_on_monitor() ) THEN
  50
  51          loslen = LEN ( command )
  52          CALL all_spaces ( command , loslen )
  53          WRITE ( command , FMT='("ls -1 ",A,"*d",I2.2,"* > .foo")' ) TRIM ( root ) , id
  54
  55          !  We stuck all of the matching files in the ".foo" file.  Now we place the
  56          !  number of the those file (i.e. how many there are) in ".foo1".  Also, if we
  57          !  do get inside one of these CPP ifdefs, then we set our access flag to true.
  58
  59 #ifdef NONSTANDARD_SYSTEM_SUBR
  60          CALL SYSTEM ( TRIM ( command ) )
  61          CALL SYSTEM ( '( cat .foo | wc -l > .foo1 )' )
  62          unix_access_ok = .TRUE.
  63 #endif
  64 #ifdef NONSTANDARD_SYSTEM_FUNC
  65          ierr = SYSTEM ( TRIM ( command ) )
  66          ierr =  SYSTEM ( '( cat .foo | wc -l > .foo1 )' )
  67          unix_access_ok = .TRUE.
  68 #endif
  69
  70          !  Test to be sure that we did indeed hit one of the ifdefs.
  71
  72          IF ( .NOT. unix_access_ok ) THEN
  73             PRINT *,'Oops, how can I access UNIX commands from Fortran?'
  74             CALL wrf_error_fatal ( 'system_or_exec_only' )
  75          END IF
  76
  77          !  Read the number of files.
  78
  79          OPEN (FILE   = '.foo1'       , &
  80                UNIT   = 112           , &
  81                STATUS = 'OLD'         , &
  82                ACCESS = 'SEQUENTIAL'  , &
  83                FORM   = 'FORMATTED'     )
  84
  85          READ ( 112 , * ) number_of_eligible_files
  86          CLOSE ( 112 )
  87
  88          !  If there are zero files, we are toast.
  89
  90          IF ( number_of_eligible_files .LE. 0 ) THEN
  91             PRINT *,'Oops, we need at least ONE input file (wrfout*) for the ndown program to read.'
  92             CALL wrf_error_fatal ( 'need_wrfout_input_data' )
  93          END IF
  94
  95       ENDIF monitor_only_code
  96
  97       !  On the monitor proc, we got the number of files.  We use that number to
  98       !  allocate space on all of the procs.
  99
 100       CALL wrf_dm_bcast_integer ( number_of_eligible_files, 1 )
 101
 102       !  Allocate space for this many files.
 103
 104       ALLOCATE ( eligible_file_name(number_of_eligible_files) , STAT=ierr )
 105
 106       !  Did the allocate work OK?
 107
 108       IF ( ierr .NE. 0 ) THEN
 109 print *,'tried to allocate ',number_of_eligible_files,' eligible files, (look at ./foo)'
 110          WRITE(message,*)'module_get_file_names: unix_ls: unable to allocate filename array Status = ',ierr
 111          CALL wrf_error_fatal( message )
 112       END IF
 113
 114       !  Initialize all of the file names to blank.
 115
 116       CALL init_module_get_file_names
 117
 118       !  Now we go back to a single monitor proc to read in the file names.
 119
 120       monitor_only_code2: IF ( wrf_dm_on_monitor() ) THEN
 121
 122          !  Open the file that has the list of filenames.
 123
 124          OPEN (FILE   = '.foo'        , &
 125                UNIT   = 111           , &
 126                STATUS = 'OLD'         , &
 127                ACCESS = 'SEQUENTIAL'  , &
 128                FORM   = 'FORMATTED'     )
 129
 130          !  Read all of the file names and store them.
 131
 132          DO loop = 1 , number_of_eligible_files
 133             READ ( 111 , FMT='(A)' ) eligible_file_name(loop)
 134 print *,TRIM(eligible_file_name(loop))
 135          END DO
 136          CLOSE ( 111 )
 137
 138          !   We clean up our own messes.
 139
 140 #ifdef NONSTANDARD_SYSTEM_SUBR
 141          CALL SYSTEM ( '/bin/rm -f .foo'  )
 142          CALL SYSTEM ( '/bin/rm -f .foo1' )
 143 #endif
 144 #ifdef NONSTANDARD_SYSTEM_FUNC
 145          ierr = SYSTEM ( '/bin/rm -f .foo'  )
 146          ierr = SYSTEM ( '/bin/rm -f .foo1' )
 147 #endif
 148
 149       ENDIF monitor_only_code2
 150
 151       !  Broadcast the file names to everyone on all of the procs.
 152
 153       DO loop = 1 , number_of_eligible_files
 154          strlen = LEN( TRIM( eligible_file_name(loop) ) )
 155          CALL wrf_dm_bcast_string ( eligible_file_name(loop) , strlen  )
 156       ENDDO
 157
 158    END SUBROUTINE unix_ls
 159
 160 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 161
 162    SUBROUTINE all_spaces ( command , length_of_char )
 163
 164       IMPLICIT NONE
 165
 166       INTEGER :: length_of_char
 167       CHARACTER (LEN=length_of_char) :: command
 168       INTEGER :: loop
 169
 170       DO loop = 1 , length_of_char
 171          command(loop:loop) = ' '
 172       END DO
 173
 174    END SUBROUTINE all_spaces
 175
 176 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 177
 178    SUBROUTINE init_module_get_file_names
 179
 180       IMPLICIT NONE
 181       eligible_file_name = '                                                  ' // &
 182                            '                                                  ' // &
 183                            '                                '
 184
 185    END SUBROUTINE init_module_get_file_names
 186
 187 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 188
 189 END MODULE module_get_file_names
 190
 191 !program foo
 192 !USE module_get_file_names
 193 !call init_module_get_file_names
 194 !call unix_ls ( 'wrf_real' , 1 )
 195 !end program foo