| 1 | PROGRAM test_g2lib |
|---|
| 2 | implicit none |
|---|
| 3 | |
|---|
| 4 | integer , dimension(13) :: listsec1 |
|---|
| 5 | integer , dimension(2) :: listsec0 |
|---|
| 6 | integer :: ierr |
|---|
| 7 | integer , parameter :: lcgrib = 2000000 |
|---|
| 8 | character (lcgrib) :: cgrib |
|---|
| 9 | |
|---|
| 10 | integer, dimension(5) :: igds |
|---|
| 11 | integer, parameter :: igdstmplen = 25 |
|---|
| 12 | integer, dimension(igdstmplen) :: igdstmpl |
|---|
| 13 | integer, parameter :: idefnum = 0 |
|---|
| 14 | integer, dimension(idefnum) :: ideflist |
|---|
| 15 | |
|---|
| 16 | integer :: ipdsnum |
|---|
| 17 | integer, parameter :: ipdstmplen = 15 |
|---|
| 18 | integer, dimension(ipdstmplen) :: ipdstmpl |
|---|
| 19 | integer :: numcoord |
|---|
| 20 | integer, dimension(1) :: coordlist |
|---|
| 21 | integer :: idrsnum |
|---|
| 22 | integer, parameter :: idrstmplen = 7 |
|---|
| 23 | integer, dimension(idrstmplen) :: idrstmpl |
|---|
| 24 | integer :: ibmap |
|---|
| 25 | integer, dimension(1) :: bmap |
|---|
| 26 | integer, parameter :: ngrdpts=20*25 |
|---|
| 27 | real :: fld(ngrdpts) |
|---|
| 28 | |
|---|
| 29 | ! |
|---|
| 30 | ! Create the grib message |
|---|
| 31 | ! |
|---|
| 32 | listsec0(1) = 0 ! Discipline (Table 0.0) |
|---|
| 33 | listsec0(2) = 2 ! Grib edition number |
|---|
| 34 | |
|---|
| 35 | listsec1(1) = 255 ! Id of Originating Center (255 for missing) |
|---|
| 36 | listsec1(2) = 255 ! Id of originating sub-center (255 for missing) |
|---|
| 37 | listsec1(3) = 1 ! Master Table Version # |
|---|
| 38 | listsec1(4) = 1 ! Local table version # |
|---|
| 39 | listsec1(5) = 1 ! Significance of reference time, 1 indicates start of forecast |
|---|
| 40 | |
|---|
| 41 | listsec1(6) = 2005 ! Year of reference |
|---|
| 42 | listsec1(7) = 09 ! Month of reference |
|---|
| 43 | listsec1(8) = 30 ! Month of reference |
|---|
| 44 | listsec1(9) = 0 ! Hour |
|---|
| 45 | listsec1(10) = 0 ! Minute |
|---|
| 46 | listsec1(11) = 0 ! Second |
|---|
| 47 | listsec1(12) = 255 ! Production Status |
|---|
| 48 | listsec1(13) = 1 ! Type of data (1 for forecast) |
|---|
| 49 | |
|---|
| 50 | call gribcreate(cgrib,lcgrib,listsec0,listsec1,ierr) |
|---|
| 51 | if (ierr .ne. 0) then |
|---|
| 52 | print *, 'gribcreate failed with ierr: ',ierr |
|---|
| 53 | endif |
|---|
| 54 | |
|---|
| 55 | |
|---|
| 56 | igds(1) = 0 ! Source of grid definition |
|---|
| 57 | igds(2) = ngrdpts! Number of points in grid |
|---|
| 58 | igds(3) = 0 ! |
|---|
| 59 | igds(4) = 0 |
|---|
| 60 | |
|---|
| 61 | ! Here, setup the parameters that are common to all WRF projections |
|---|
| 62 | |
|---|
| 63 | igdstmpl(1) = 1 ! Shape of earth (1 for spherical with specified radius) |
|---|
| 64 | igdstmpl(2) = 1 ! Scale factor for earth radius |
|---|
| 65 | igdstmpl(3) = 6370*1000 ! Radius of earth |
|---|
| 66 | igdstmpl(4) = 0 ! Scale factor for major axis |
|---|
| 67 | igdstmpl(5) = 0 ! Major axis |
|---|
| 68 | igdstmpl(6) = 0 ! Scale factor for minor axis |
|---|
| 69 | igdstmpl(7) = 0 ! Minor axis |
|---|
| 70 | igdstmpl(8) = 20 ! Number of points along x axis |
|---|
| 71 | igdstmpl(9) = 25 ! Number of points along y axis |
|---|
| 72 | |
|---|
| 73 | |
|---|
| 74 | ! This is the setup for lat/lon projection |
|---|
| 75 | igds(5) = 0 |
|---|
| 76 | igdstmpl(10) = 0 ! Basic Angle of init projection (not important to us) |
|---|
| 77 | igdstmpl(11) = 0 ! Subdivision of basic angle |
|---|
| 78 | igdstmpl(12) = -20*1000000 |
|---|
| 79 | igdstmpl(13) = 20*1000000 |
|---|
| 80 | igdstmpl(14) = 128 ! Resolution and component flags |
|---|
| 81 | igdstmpl(15) = 0*1000000 |
|---|
| 82 | igdstmpl(16) = 40*1000000 |
|---|
| 83 | |
|---|
| 84 | ! Warning, the following assumes that dx and dy are valid at the equator. |
|---|
| 85 | ! It is not clear in WRF where dx and dy are valid for latlon projections |
|---|
| 86 | igdstmpl(17) = 12000 ! i-direction increment in micro degs |
|---|
| 87 | igdstmpl(18) = 12000 ! j-direction increment in micro degs |
|---|
| 88 | |
|---|
| 89 | igdstmpl(19) = 64 ! Scanning mode |
|---|
| 90 | |
|---|
| 91 | call addgrid(cgrib,lcgrib,igds,igdstmpl,igdstmplen,ideflist,idefnum,ierr) |
|---|
| 92 | if (ierr .ne. 0) then |
|---|
| 93 | print *, 'addgrid failed with ierr: ',ierr |
|---|
| 94 | endif |
|---|
| 95 | |
|---|
| 96 | |
|---|
| 97 | ipdsnum = 0 ! Product definition template (0 for horiz grid) |
|---|
| 98 | |
|---|
| 99 | ipdstmpl(1) = 0 ! Parameter category |
|---|
| 100 | ipdstmpl(2) = 1 ! Parameter number |
|---|
| 101 | ipdstmpl(3) = 2 ! Type of generating process (2 for forecast) |
|---|
| 102 | ipdstmpl(4) = 255 ! Background generating process id |
|---|
| 103 | ipdstmpl(5) = 255 ! Analysis or forecast generating process id |
|---|
| 104 | ipdstmpl(6) = 0 ! Data cutoff period (Hours) |
|---|
| 105 | ipdstmpl(7) = 0 ! Data cutoff period (minutes) |
|---|
| 106 | ipdstmpl(8) = 13 ! Time range indicator (13 for seconds) |
|---|
| 107 | ipdstmpl(9) = 10800 ! Forecast time |
|---|
| 108 | |
|---|
| 109 | ipdstmpl(10) = 111 ! Type of first surface (111 for Eta level) |
|---|
| 110 | ipdstmpl(11) = 0 ! Scale factor for 1st surface |
|---|
| 111 | ipdstmpl(12) = 9965 ! First fixed surface |
|---|
| 112 | ipdstmpl(13) = 255 ! Type of second fixed surface |
|---|
| 113 | ipdstmpl(14) = 255 ! Scale factor for 2nd surface |
|---|
| 114 | ipdstmpl(15) = 0 |
|---|
| 115 | numcoord = 0 |
|---|
| 116 | coordlist(1) = 0 |
|---|
| 117 | |
|---|
| 118 | ! Set Data Representation templ (40 for JPEG2000, 41 for PNG) |
|---|
| 119 | idrsnum = 40 |
|---|
| 120 | idrstmpl(1) = 255 ! Reference value - ignored on input |
|---|
| 121 | idrstmpl(2) = 0 ! Binary scale factor |
|---|
| 122 | idrstmpl(3) = 3 ! Decimal scale factor |
|---|
| 123 | idrstmpl(4) = 0 ! number of bits for each data value - ignored on |
|---|
| 124 | idrstmpl(5) = 0 ! Original field type - ignored on input |
|---|
| 125 | idrstmpl(6) = 0 ! 0 for lossless compression |
|---|
| 126 | idrstmpl(7) = 255 ! Desired compression ratio if idrstmpl(6) != 0 |
|---|
| 127 | ibmap = 255 ! Flag for bitmap |
|---|
| 128 | |
|---|
| 129 | fld = 1.2 |
|---|
| 130 | |
|---|
| 131 | call addfield(cgrib, lcgrib, ipdsnum, ipdstmpl, ipdstmplen, coordlist, & |
|---|
| 132 | numcoord, idrsnum, idrstmpl, idrstmplen, fld, ngrdpts, ibmap, & |
|---|
| 133 | bmap, ierr) |
|---|
| 134 | |
|---|
| 135 | if (ierr .ne. 0) then |
|---|
| 136 | print *, 'addfield failed with ierr: ',ierr |
|---|
| 137 | endif |
|---|
| 138 | |
|---|
| 139 | |
|---|
| 140 | end PROGRAM test_g2lib |
|---|
| 141 | |
|---|
