| 1 | PROGRAM checkGrib |
|---|
| 2 | |
|---|
| 3 | USE cgutils |
|---|
| 4 | |
|---|
| 5 | IMPLICIT NONE |
|---|
| 6 | |
|---|
| 7 | INTEGER :: i, stat |
|---|
| 8 | INTEGER :: num_filepaths, expected_num_levels |
|---|
| 9 | CHARACTER(LEN=16) :: source_str, levels_str |
|---|
| 10 | CHARACTER(LEN=256), DIMENSION(100) :: filepaths |
|---|
| 11 | LOGICAL :: check_fcst, check_anl, check_grib2 |
|---|
| 12 | |
|---|
| 13 | INTEGER :: return_code |
|---|
| 14 | |
|---|
| 15 | |
|---|
| 16 | CALL get_command_args(source_str, levels_str, & |
|---|
| 17 | & filepaths, num_filepaths, & |
|---|
| 18 | & check_fcst, check_anl, check_grib2) |
|---|
| 19 | !WRITE(6,*) '----- got args ------' |
|---|
| 20 | !WRITE(6,*) 'source_str: ', TRIM(source_str) |
|---|
| 21 | !WRITE(6,*) 'levels_str: ', TRIM(levels_str) |
|---|
| 22 | !WRITE(6,*) 'filepaths:' |
|---|
| 23 | !DO i=1,num_filepaths |
|---|
| 24 | ! WRITE(6,*) TRIM(filepaths(i)) |
|---|
| 25 | !END DO |
|---|
| 26 | !WRITE(6,*) '----- got args ------' |
|---|
| 27 | |
|---|
| 28 | ! Convert string to integer |
|---|
| 29 | READ(levels_str,*,IOSTAT=stat) expected_num_levels |
|---|
| 30 | |
|---|
| 31 | DO i=1,num_filepaths |
|---|
| 32 | |
|---|
| 33 | IF ( TRIM(source_str) .EQ. 'ECMWF' ) THEN |
|---|
| 34 | |
|---|
| 35 | return_code = cgutils_check_ecmwf_grib(filepaths(i), & |
|---|
| 36 | & expected_num_levels, & |
|---|
| 37 | & check_fcst, check_anl, check_grib2) |
|---|
| 38 | ELSE IF ( TRIM(source_str) .EQ. 'NCEP' ) THEN |
|---|
| 39 | return_code = cgutils_check_ncep_grib2(filepaths(i), & |
|---|
| 40 | & expected_num_levels, & |
|---|
| 41 | & check_fcst, check_anl, check_grib2) |
|---|
| 42 | ELSE IF ( TRIM(source_str) .EQ. 'NCEPFV3' ) THEN |
|---|
| 43 | return_code = cgutils_check_fv3_grib2(filepaths(i), & |
|---|
| 44 | & expected_num_levels, & |
|---|
| 45 | & check_fcst, check_anl, check_grib2) |
|---|
| 46 | |
|---|
| 47 | ELSE |
|---|
| 48 | |
|---|
| 49 | WRITE(6,*) 'Invalid source string: ', TRIM(source_str) |
|---|
| 50 | CALL EXIT(2) |
|---|
| 51 | |
|---|
| 52 | ENDIF |
|---|
| 53 | |
|---|
| 54 | !PRINT *, 'return_code: ', return_code |
|---|
| 55 | IF (return_code .EQ. 0) THEN |
|---|
| 56 | WRITE(6,*) 'Passed: ', TRIM(filepaths(i)) |
|---|
| 57 | ELSE |
|---|
| 58 | WRITE(6,*) 'Failed on: ', TRIM(filepaths(i)) |
|---|
| 59 | CALL EXIT(return_code) |
|---|
| 60 | ENDIF |
|---|
| 61 | END DO |
|---|
| 62 | |
|---|
| 63 | |
|---|
| 64 | |
|---|
| 65 | END PROGRAM checkGrib |
|---|
| 66 | |
|---|
| 67 | |
|---|
| 68 | SUBROUTINE get_command_args(source_arg, levels_arg, & |
|---|
| 69 | & filepaths, num_filepaths, & |
|---|
| 70 | & check_fcst, check_anl, check_grib2) |
|---|
| 71 | |
|---|
| 72 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
|---|
| 73 | ! This subroutine makes an effort to retrieve the command line arguments |
|---|
| 74 | ! in string format. It makes no effort to verify their values |
|---|
| 75 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
|---|
| 76 | |
|---|
| 77 | CHARACTER(LEN=16), INTENT(OUT) :: source_arg, levels_arg |
|---|
| 78 | CHARACTER(LEN=256), DIMENSION(100), INTENT(OUT) :: filepaths |
|---|
| 79 | INTEGER, INTENT(OUT) :: num_filepaths |
|---|
| 80 | LOGICAL, INTENT(OUT) :: check_fcst, check_anl, check_grib2 |
|---|
| 81 | |
|---|
| 82 | INTEGER :: arg_idx |
|---|
| 83 | |
|---|
| 84 | INTEGER :: num_cli_args |
|---|
| 85 | CHARACTER(LEN=256) :: arg_str |
|---|
| 86 | LOGICAL :: required_flags_processed |
|---|
| 87 | |
|---|
| 88 | ! Logic in the following loop will set this to True only if |
|---|
| 89 | ! the required args are storing something other than 'NUL' |
|---|
| 90 | required_flags_processed = .FALSE. |
|---|
| 91 | source_arg = 'NUL' |
|---|
| 92 | levels_arg = 'NUL' |
|---|
| 93 | |
|---|
| 94 | ! Default values |
|---|
| 95 | check_fcst = .FALSE. |
|---|
| 96 | check_anl = .FALSE. |
|---|
| 97 | check_grib2 = .FALSE. |
|---|
| 98 | |
|---|
| 99 | |
|---|
| 100 | num_cli_args = IARGC() |
|---|
| 101 | ! Abort if there were no args |
|---|
| 102 | IF (num_cli_args .LT. 1) THEN |
|---|
| 103 | WRITE(0,*) 'No arguments provided' |
|---|
| 104 | CALL print_usage |
|---|
| 105 | CALL EXIT(2) |
|---|
| 106 | ENDIF |
|---|
| 107 | |
|---|
| 108 | ! We expect commandline flags, usually with arguments, followed |
|---|
| 109 | ! by a variable-size list of filepaths |
|---|
| 110 | num_filepaths = 0 |
|---|
| 111 | arg_idx = 1 |
|---|
| 112 | DO WHILE (arg_idx .LE. num_cli_args) |
|---|
| 113 | |
|---|
| 114 | |
|---|
| 115 | CALL GETARG(arg_idx, arg_str) |
|---|
| 116 | |
|---|
| 117 | SELECT CASE ( TRIM(arg_str) ) |
|---|
| 118 | CASE ('--source') |
|---|
| 119 | arg_idx = arg_idx + 1 |
|---|
| 120 | CALL GETARG(arg_idx, source_arg) |
|---|
| 121 | IF (.NOT. ( (source_arg .EQ. 'NUL') .OR. & |
|---|
| 122 | & (levels_arg .EQ. 'NUL') ) ) THEN |
|---|
| 123 | required_flags_processed = .TRUE. |
|---|
| 124 | ENDIF |
|---|
| 125 | |
|---|
| 126 | CASE ('--levels') |
|---|
| 127 | arg_idx = arg_idx + 1 |
|---|
| 128 | CALL GETARG(arg_idx, levels_arg) |
|---|
| 129 | IF (.NOT. ( (source_arg .EQ. 'NUL') .OR. & |
|---|
| 130 | & (levels_arg .EQ. 'NUL') ) ) THEN |
|---|
| 131 | required_flags_processed = .TRUE. |
|---|
| 132 | ENDIF |
|---|
| 133 | |
|---|
| 134 | CASE ('--checkfcst') |
|---|
| 135 | check_fcst = .TRUE. |
|---|
| 136 | |
|---|
| 137 | CASE ('--checkanl') |
|---|
| 138 | check_anl = .TRUE. |
|---|
| 139 | |
|---|
| 140 | CASE ('--checkgrib2') |
|---|
| 141 | check_grib2 = .TRUE. |
|---|
| 142 | |
|---|
| 143 | |
|---|
| 144 | CASE default |
|---|
| 145 | ! We should only be here if required flags have been |
|---|
| 146 | ! processed, in which case we assume any remaining tokens |
|---|
| 147 | ! are paths to GRIB files |
|---|
| 148 | ! |
|---|
| 149 | ! Note - an additional sanity check might be to see if the |
|---|
| 150 | ! first two characters of the token are '--', in which case |
|---|
| 151 | ! someone might have slipped in another command flag at a |
|---|
| 152 | ! time when we're only expecting pathnames. But, I chose |
|---|
| 153 | ! not to implement that at this time. I figure the utility |
|---|
| 154 | ! will barf when it tries to open an invalid file. |
|---|
| 155 | IF (.NOT. required_flags_processed) THEN |
|---|
| 156 | WRITE(0,*) 'args missing or out of sync' |
|---|
| 157 | CALL print_usage |
|---|
| 158 | CALL EXIT(2) |
|---|
| 159 | ENDIF |
|---|
| 160 | num_filepaths = num_filepaths + 1 |
|---|
| 161 | filepaths(num_filepaths) = TRIM(arg_str) |
|---|
| 162 | |
|---|
| 163 | END SELECT |
|---|
| 164 | |
|---|
| 165 | !PRINT *, TRIM(arg_str) |
|---|
| 166 | arg_idx = arg_idx + 1 |
|---|
| 167 | END DO |
|---|
| 168 | |
|---|
| 169 | ! Let's make sure that at least one filepath was counted |
|---|
| 170 | IF (num_filepaths .LT. 1) THEN |
|---|
| 171 | WRITE(0,*) 'No GRIB files were specified' |
|---|
| 172 | CALL print_usage |
|---|
| 173 | CALL EXIT(2) |
|---|
| 174 | ENDIF |
|---|
| 175 | |
|---|
| 176 | ! Let's make sure that both checkfcst and checkanl weren't specified |
|---|
| 177 | IF (check_fcst .AND. check_anl) THEN |
|---|
| 178 | WRITE(0,*) 'Only one of --checkfcst and --checkanl can be specified' |
|---|
| 179 | CALL print_usage |
|---|
| 180 | CALL EXIT(2) |
|---|
| 181 | ENDIF |
|---|
| 182 | |
|---|
| 183 | |
|---|
| 184 | |
|---|
| 185 | END SUBROUTINE get_command_args |
|---|
| 186 | |
|---|
| 187 | SUBROUTINE print_usage |
|---|
| 188 | |
|---|
| 189 | WRITE(0,*) ' ' |
|---|
| 190 | WRITE(0,*) 'Usage: ' |
|---|
| 191 | WRITE(0,*) ' ' |
|---|
| 192 | WRITE(0,*) 'checkgrib --source [ECMWF | NCEP | NCEPFV3] --levels <int> ' |
|---|
| 193 | WRITE(0,*) ' [ --checkfcst | --checkanl | --checkgrib2 ]' |
|---|
| 194 | WRITE(0,*) ' path1 path2 ...' |
|---|
| 195 | WRITE(0,*) ' ' |
|---|
| 196 | |
|---|
| 197 | END SUBROUTINE print_usage |
|---|
| 198 | |
|---|
