module_get_file_names.F

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