00001 ! Copyright 2005-2018 ECMWF
00002 ! This software is licensed under the terms of the Apache Licence Version 2.0
00003 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
00004 !
00005 ! In applying this licence, ECMWF does not waive the privileges and immunities granted to it by
00006 ! virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction.
00007 !
00008 !
00009 ! Description: how to create a new GRIB message by cloning
00010 ! an existing message.
00011 !
00012 !
00013 ! Author: Anne Fouilloux
00014 !
00015 !
00016 program clone
00017 use grib_api
00018 implicit none
00019 integer :: err,i,iret
00020 integer :: nx, ny
00021 integer :: infile,outfile
00022 integer :: igrib_in
00023 integer :: igrib_out
00024 character(len=2) :: step
00025 double precision, dimension(:,:), allocatable :: field2D
00026
00027
00028 call grib_open_file(infile,'../../data/constant_field.grib1','r')
00029 call grib_open_file(outfile,'out.grib1','w')
00030
00031 ! a new grib message is loaded from file
00032 ! igrib is the grib id to be used in subsequent calls
00033 call grib_new_from_file(infile,igrib_in)
00034
00035 call grib_get(igrib_in,"numberOfPointsAlongAParallel", nx)
00036
00037 call grib_get(igrib_in,"numberOfPointsAlongAMeridian",ny)
00038
00039 allocate(field2D(nx,ny),stat=err)
00040
00041 if (err .ne. 0) then
00042 print*, 'Failed to allocate ', nx*ny, ' values'
00043 STOP
00044 end if
00045 ! clone the constant field to create 4 new GRIB messages
00046 do i=0,18,6
00047 call grib_clone(igrib_in, igrib_out)
00048 write(step,'(i2)') i
00049 ! Careful: stepRange is a string (could be 0-6, 12-24, etc.)
00050 ! use adjustl to remove blank from the left.
00051 call grib_set(igrib_out,'stepRange',adjustl(step))
00052
00053 call generate_field(field2D)
00054
00055 ! use pack to create 1D values
00056 call grib_set(igrib_out,'values',pack(field2D, mask=.true.))
00057
00058 ! write cloned messages to a file
00059 call grib_write(igrib_out,outfile)
00060 call grib_release(igrib_out)
00061 end do
00062
00063 call grib_release(igrib_in)
00064
00065 call grib_close_file(infile)
00066
00067 call grib_close_file(outfile)
00068 deallocate(field2D)
00069
00070 contains
00071 !======================================
00072 subroutine generate_field(gfield2D)
00073 double precision, dimension(:,:) :: gfield2D
00074
00075 call random_number(gfield2D)
00076 end subroutine generate_field
00077 !======================================
00078
00079 end program clone
