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       !  GAC 20140321 - Addition to prevent attempts to reallocate same variable.
 104       !  This used to be a bug when running convert_emiss for nested domains
 105       !  a while back, now it is probably just a paranoid check.
 106
 107       IF ( ALLOCATED ( eligible_file_name ) ) DEALLOCATE ( eligible_file_name )
 108       ALLOCATE ( eligible_file_name(number_of_eligible_files) , STAT=ierr )
 109
 110       !  Did the allocate work OK?
 111
 112       IF ( ierr .NE. 0 ) THEN
 113 print *,'tried to allocate ',number_of_eligible_files,' eligible files, (look at ./foo)'
 114          WRITE(message,*)'module_get_file_names: unix_ls: unable to allocate filename array Status = ',ierr
 115          CALL wrf_error_fatal( message )
 116       END IF
 117
 118       !  Initialize all of the file names to blank.
 119
 120       CALL init_module_get_file_names
 121
 122       !  Now we go back to a single monitor proc to read in the file names.
 123
 124       monitor_only_code2: IF ( wrf_dm_on_monitor() ) THEN
 125
 126          !  Open the file that has the list of filenames.
 127
 128          OPEN (FILE   = '.foo'        , &
 129                UNIT   = 111           , &
 130                STATUS = 'OLD'         , &
 131                ACCESS = 'SEQUENTIAL'  , &
 132                FORM   = 'FORMATTED'     )
 133
 134          !  Read all of the file names and store them.
 135
 136          DO loop = 1 , number_of_eligible_files
 137             READ ( 111 , FMT='(A)' ) eligible_file_name(loop)
 138 print *,TRIM(eligible_file_name(loop))
 139          END DO
 140          CLOSE ( 111 )
 141
 142          !   We clean up our own messes.
 143
 144 #ifdef NONSTANDARD_SYSTEM_SUBR
 145          CALL SYSTEM ( '/bin/rm -f .foo'  )
 146          CALL SYSTEM ( '/bin/rm -f .foo1' )
 147 #endif
 148 #ifdef NONSTANDARD_SYSTEM_FUNC
 149          ierr = SYSTEM ( '/bin/rm -f .foo'  )
 150          ierr = SYSTEM ( '/bin/rm -f .foo1' )
 151 #endif
 152
 153       ENDIF monitor_only_code2
 154
 155       !  Broadcast the file names to everyone on all of the procs.
 156
 157       DO loop = 1 , number_of_eligible_files
 158          strlen = LEN( TRIM( eligible_file_name(loop) ) )
 159          CALL wrf_dm_bcast_string ( eligible_file_name(loop) , strlen  )
 160       ENDDO
 161
 162    END SUBROUTINE unix_ls
 163
 164 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 165
 166    SUBROUTINE all_spaces ( command , length_of_char )
 167
 168       IMPLICIT NONE
 169
 170       INTEGER :: length_of_char
 171       CHARACTER (LEN=length_of_char) :: command
 172       INTEGER :: loop
 173
 174       DO loop = 1 , length_of_char
 175          command(loop:loop) = ' '
 176       END DO
 177
 178    END SUBROUTINE all_spaces
 179
 180 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 181
 182    SUBROUTINE init_module_get_file_names
 183
 184       IMPLICIT NONE
 185       eligible_file_name = '                                                  ' // &
 186                            '                                                  ' // &
 187                            '                                '
 188
 189    END SUBROUTINE init_module_get_file_names
 190
 191 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 192
 193 END MODULE module_get_file_names
 194
 195 !program foo
 196 !USE module_get_file_names
 197 !call init_module_get_file_names
 198 !call unix_ls ( 'wrf_real' , 1 )
 199 !end program foo