| 1 | module check_gribfile_mod |
|---|
| 2 | |
|---|
| 3 | !* |
|---|
| 4 | ! Valid-License-Identifier: GPL-3.0-or-later |
|---|
| 5 | ! Copyright (c) 2018 Petra Seibert (petra seibert at univie ac at) |
|---|
| 6 | ! |
|---|
| 7 | ! Prepared for use in FLEXPART (see flexpart.eu) version 10+ |
|---|
| 8 | ! 1. provide centre ids for ECMWF and NCEP |
|---|
| 9 | ! 2. obtain centre id from a given grib file |
|---|
| 10 | ! intended to replace class_gribfile from ctbto project |
|---|
| 11 | ! requires grib_api_fortran90 and grib_api |
|---|
| 12 | ! either from eccodes or grib_api |
|---|
| 13 | |
|---|
| 14 | ! I am using the convention to put an abbreviated module name (here: cg) |
|---|
| 15 | ! in front of public entities. If they are integer, then icg. |
|---|
| 16 | ! subroutines / functions from external libs with upper first letter |
|---|
| 17 | |
|---|
| 18 | implicit none |
|---|
| 19 | |
|---|
| 20 | integer, parameter :: icg_id_ncep = 7, icg_id_ecmwf = 98 |
|---|
| 21 | !! official centre codes |
|---|
| 22 | integer :: icentre ! centre ID found |
|---|
| 23 | |
|---|
| 24 | contains |
|---|
| 25 | |
|---|
| 26 | subroutine cg_get_centre(pfname, icentre) |
|---|
| 27 | |
|---|
| 28 | ! this subroutine returns a code for the centre which produced the gribfile |
|---|
| 29 | |
|---|
| 30 | use grib_api |
|---|
| 31 | |
|---|
| 32 | integer, intent(out) :: icentre |
|---|
| 33 | integer :: ifile ! grib file handle |
|---|
| 34 | integer :: iret ! status code |
|---|
| 35 | integer :: igrib ! message handle |
|---|
| 36 | character (len=*), intent(in) :: pfname ! path+filenmae |
|---|
| 37 | |
|---|
| 38 | call Grib_open_file(ifile,pfname,'r',iret) |
|---|
| 39 | if (iret == 0) then |
|---|
| 40 | |
|---|
| 41 | call Grib_new_from_file(ifile,igrib) ! load first message |
|---|
| 42 | call Grib_get(igrib,'centre',icentre) ! read centre ID |
|---|
| 43 | call Grib_close_file(ifile) ! done |
|---|
| 44 | |
|---|
| 45 | if (icentre .ne. icg_id_ecmwf .and. & |
|---|
| 46 | icentre .ne. icg_id_ncep) then |
|---|
| 47 | !! centre not foreseen in Fp |
|---|
| 48 | write (*,*) ' #### FLEXPART MODEL ERROR! Met input file' |
|---|
| 49 | write (*,*) ' #### '//trim(pfname) |
|---|
| 50 | write (*,*) ' #### is neither ECMWF nor NCEP grib file' |
|---|
| 51 | stop 'error in check_gribfile' |
|---|
| 52 | endif |
|---|
| 53 | |
|---|
| 54 | else |
|---|
| 55 | |
|---|
| 56 | !! reading gribfile failed |
|---|
| 57 | write (*,*) ' #### FLEXPART MODEL ERROR! Met input file' |
|---|
| 58 | write (*,*) ' #### '//trim(pfname) |
|---|
| 59 | write (*,*) ' #### cannot be opened with grib_api' |
|---|
| 60 | stop 'error in check_gribfile' |
|---|
| 61 | |
|---|
| 62 | endif |
|---|
| 63 | |
|---|
| 64 | end subroutine cg_get_centre |
|---|
| 65 | |
|---|
| 66 | end module check_gribfile_mod |
|---|
| 67 | |
|---|
| 68 | ! what needs to be done to replace the current code with this one: |
|---|
| 69 | ! see email |
|---|
