MODULE module_get_file_names 2
! This module is used by the ndown program. We can have multiple output
! files generated from the wrf program. To remove the what-are-the-
! files-to-input-to-ndown task from the user, we use a couple of UNIX
! commands. These are activated from either the "system" command or
! the "exec" command. Neither is part of the Fortran standard.
INTEGER :: number_of_eligible_files
CHARACTER(LEN=132) , DIMENSION(:) , ALLOCATABLE :: eligible_file_name
CONTAINS
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
#ifdef crayx1
SUBROUTINE system(cmd) 4
IMPLICIT NONE
CHARACTER (LEN=*) , INTENT(IN) :: cmd
integer :: ierr
call pxfsystem(cmd, len(cmd), ierr)
RETURN
END SUBROUTINE system
#endif
SUBROUTINE unix_ls ( root , id ) 1,11
! USE module_dm
IMPLICIT NONE
CHARACTER (LEN=*) , INTENT(IN) :: root
INTEGER , INTENT(IN) :: id
CHARACTER (LEN=132) :: command
INTEGER :: ierr , loop , loslen , strlen
#ifdef NONSTANDARD_SYSTEM_FUNC
INTEGER , EXTERNAL :: SYSTEM
#endif
LOGICAL :: unix_access_ok
LOGICAL, EXTERNAL :: wrf_dm_on_monitor
CHARACTER*256 message
! This is to make sure that we successfully use one of the available methods
! for getting at a UNIX command. This is an initialized flag.
unix_access_ok = .FALSE.
! Build a UNIX command, and "ls", of all of the files mnatching the "root*" prefix.
monitor_only_code : IF ( wrf_dm_on_monitor() ) THEN
loslen = LEN ( command )
CALL all_spaces
( command , loslen )
WRITE ( command , FMT='("ls -1 ",A,"*d",I2.2,"* > .foo")' ) TRIM ( root ) , id
! We stuck all of the matching files in the ".foo" file. Now we place the
! number of the those file (i.e. how many there are) in ".foo1". Also, if we
! do get inside one of these CPP ifdefs, then we set our access flag to true.
#ifdef NONSTANDARD_SYSTEM_SUBR
CALL SYSTEM
( TRIM ( command ) )
CALL SYSTEM
( '( cat .foo | wc -l > .foo1 )' )
unix_access_ok = .TRUE.
#endif
#ifdef NONSTANDARD_SYSTEM_FUNC
ierr = SYSTEM ( TRIM ( command ) )
ierr = SYSTEM ( '( cat .foo | wc -l > .foo1 )' )
unix_access_ok = .TRUE.
#endif
! Test to be sure that we did indeed hit one of the ifdefs.
IF ( .NOT. unix_access_ok ) THEN
PRINT *,'Oops, how can I access UNIX commands from Fortran?'
CALL wrf_error_fatal
( 'system_or_exec_only' )
END IF
! Read the number of files.
OPEN (FILE = '.foo1' , &
UNIT = 112 , &
STATUS = 'OLD' , &
ACCESS = 'SEQUENTIAL' , &
FORM = 'FORMATTED' )
READ ( 112 , * ) number_of_eligible_files
CLOSE ( 112 )
! If there are zero files, we are toast.
IF ( number_of_eligible_files .LE. 0 ) THEN
PRINT *,'Oops, we need at least ONE input file (wrfout*) for the ndown program to read.'
CALL wrf_error_fatal
( 'need_wrfout_input_data' )
END IF
ENDIF monitor_only_code
! On the monitor proc, we got the number of files. We use that number to
! allocate space on all of the procs.
CALL wrf_dm_bcast_integer
( number_of_eligible_files, 1 )
! Allocate space for this many files.
ALLOCATE ( eligible_file_name(number_of_eligible_files) , STAT=ierr )
! Did the allocate work OK?
IF ( ierr .NE. 0 ) THEN
print *,'tried to allocate ',number_of_eligible_files,' eligible files, (look at ./foo)'
WRITE(message,*)'module_get_file_names: unix_ls: unable to allocate filename array Status = ',ierr
CALL wrf_error_fatal
( message )
END IF
! Initialize all of the file names to blank.
CALL init_module_get_file_names
! Now we go back to a single monitor proc to read in the file names.
monitor_only_code2: IF ( wrf_dm_on_monitor() ) THEN
! Open the file that has the list of filenames.
OPEN (FILE = '.foo' , &
UNIT = 111 , &
STATUS = 'OLD' , &
ACCESS = 'SEQUENTIAL' , &
FORM = 'FORMATTED' )
! Read all of the file names and store them.
DO loop = 1 , number_of_eligible_files
READ ( 111 , FMT='(A)' ) eligible_file_name(loop)
print *,TRIM(eligible_file_name(loop))
END DO
CLOSE ( 111 )
! We clean up our own messes.
#ifdef NONSTANDARD_SYSTEM_SUBR
CALL SYSTEM
( '/bin/rm -f .foo' )
CALL SYSTEM
( '/bin/rm -f .foo1' )
#endif
#ifdef NONSTANDARD_SYSTEM_FUNC
ierr = SYSTEM ( '/bin/rm -f .foo' )
ierr = SYSTEM ( '/bin/rm -f .foo1' )
#endif
ENDIF monitor_only_code2
! Broadcast the file names to everyone on all of the procs.
DO loop = 1 , number_of_eligible_files
strlen = LEN( TRIM( eligible_file_name(loop) ) )
CALL wrf_dm_bcast_string
( eligible_file_name(loop) , strlen )
ENDDO
END SUBROUTINE unix_ls
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE all_spaces ( command , length_of_char ) 1
IMPLICIT NONE
INTEGER :: length_of_char
CHARACTER (LEN=length_of_char) :: command
INTEGER :: loop
DO loop = 1 , length_of_char
command(loop:loop) = ' '
END DO
END SUBROUTINE all_spaces
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE init_module_get_file_names 1
IMPLICIT NONE
eligible_file_name = ' ' // &
' ' // &
' '
END SUBROUTINE init_module_get_file_names
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
END MODULE module_get_file_names
!program foo
!USE module_get_file_names
!call init_module_get_file_names
!call unix_ls ( 'wrf_real' , 1 )
!end program foo