source: lmdz_wrf/trunk/WRFV3/share/module_get_file_names.F @ 409

MODULE module_get_file_names

!  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)
      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 )
!     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 ) 

      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
   
      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