21 module volgrid6d_alchimia_class
33 module procedure make_vg6d
37 MODULE PROCEDURE alchemy_vg6dv, alchemy_vg6d
45 subroutine make_vg6d(mayvfn,mybin,mybout,vg6din,vg6dout,allvarcomputed)
46 type(fndsv),
intent(inout) :: mayvfn
47 character(len=*),
intent(in) :: mybin(:),mybout(:)
48 type(volgrid6d),
intent(in) :: vg6din
49 type(volgrid6d),
intent(out) :: vg6dout
50 TYPE(conv_func),
pointer :: c_funcgb(:),c_funcbg(:)
51 logical,
optional :: allvarcomputed
53 integer :: i,j,nx,ny,nlevel,ntime,ntimerange,nvar,nvarin
54 integer :: ilevel,itime,itimerange,ivar,ivarin,ivarout
55 real,
allocatable :: myin(:,:),myout(:,:)
56 character(len=10) :: newbout(mayvfn%nout+mayvfn%nin)
57 TYPE(vol7d_var),
allocatable :: varv7d(:)
58 TYPE(volgrid6d_var),
allocatable :: varvg6d(:)
59 TYPE(grid_id) :: gaid_template
61 nx=vg6din%griddim%dim%nx
62 ny=vg6din%griddim%dim%ny
63 nlevel=
size(vg6din%level)
64 ntime=
size(vg6din%time)
65 ntimerange=
size(vg6din%timerange)
73 do i=1,
size(mayvfn%fnds)
74 if (
c_e(mayvfn%fnds(i)))
then
75 do j=1,
size(mayvfn%fnds(i)%bin)
76 if (
c_e(mayvfn%fnds(i)%bin(j)))
then
77 if (index_c(mybin,mayvfn%fnds(i)%bin(j)) == 0)cycle
78 if (index_c(newbout,mayvfn%fnds(i)%bin(j)) <= 0)
then
79 newbout(index_c(newbout,cmiss)) = mayvfn%fnds(i)%bin(j)
86 nvarin=count(
c_e(newbout))
89 do i=1,
size(mayvfn%fnds)
90 if (
c_e(mayvfn%fnds(i)))
then
91 do j=1,
size(mayvfn%fnds(i)%bout)
92 if (
c_e(mayvfn%fnds(i)%bout(j)))
then
93 if (index_c(newbout,mayvfn%fnds(i)%bout(j)) <= 0)
then
94 newbout(index_c(newbout,cmiss)) = mayvfn%fnds(i)%bout(j)
102 nvar=count(
c_e(newbout))
104 allocate(myout(nx*ny,nvar))
107 call init(vg6dout, vg6din%griddim, vg6din%time_definition, categoryappend=
"generated by alchimia make")
108 call volgrid6d_alloc(vg6dout, ntime=ntime, nlevel=nlevel, ntimerange=ntimerange, nvar=nvar)
109 call volgrid6d_alloc_vol(vg6dout,inivol=.true.,decode=.true.)
112 allocate(varvg6d(nvar),source=volgrid6d_var_miss)
113 allocate (varv7d(nvar),source=vol7d_var_miss)
117 ivarin = index_c(mybin,newbout(ivar))
120 IF (ivarin == 0)
THEN
122 CALL l4f_log(l4f_debug,
"variable to compute in make_vg6d: "//newbout(ivar))
129 varvg6d(ivarout)=vg6din%var(ivarin)
130 call init(gaid_template)
134 DO itimerange=1,ntimerange
135 IF (
c_e(vg6din%gaid(ilevel,itime,itimerange,ivarin)))
THEN
136 IF (.NOT.
ASSOCIATED(vg6din%voldati))
THEN
137 CALL grid_id_decode_data(vg6din%gaid(ilevel,itime,itimerange,ivarin),&
138 vg6dout%voldati(:,:,ilevel,itime,itimerange,ivarout))
140 vg6dout%voldati(:,:,ilevel,itime,itimerange,ivarout) = &
141 vg6din%voldati(:,:,ilevel,itime,itimerange,ivarin)
144 CALL copy(vg6din%gaid(ilevel,itime,itimerange,ivarin), &
145 vg6dout%gaid(ilevel,itime,itimerange,ivarout))
147 IF (.NOT.
c_e(gaid_template)) &
148 gaid_template = vg6din%gaid(ilevel,itime,itimerange,ivarin)
156 CALL vargrib2varbufr(varvg6d(:nvarin), varv7d(:nvarin), c_funcgb)
158 do ivar = nvarin+1, nvar
159 call init(varv7d(ivar),newbout(ivar))
162 CALL varbufr2vargrib(varv7d(nvarin+1:), varvg6d(nvarin+1:), c_funcbg, gaid_template)
164 vg6dout%time=vg6din%time
165 vg6dout%timerange=vg6din%timerange
166 vg6dout%level=vg6din%level
171 do itimerange=1,ntimerange
172 do i=
size(mayvfn%fnds),1,-1
174 if (
c_e(mayvfn%fnds(i)) .and. .not. match(mayvfn%fnds(i)%name,
"copy*") )
then
176 call l4f_log(l4f_debug,
"execute function: "//mayvfn%fnds(i)%name)
178 myin=reshape(vg6dout%voldati(:,:,ilevel,itime,itimerange,:),(/nx*ny,nvar/))
180 IF (
ASSOCIATED(c_funcgb))
THEN
182 call compute(c_funcgb(ivar),myin(:,ivar))
190 call mayvfn%fnds(i)%fn(newbout,newbout,mayvfn%fnds(i)%bin,mayvfn%fnds(i)%bout,myin,myout)
192 IF (
ASSOCIATED(c_funcbg))
THEN
193 DO ivar = 1,
size(mayvfn%fnds(i)%bout)
194 ivarout = index_c(newbout,mayvfn%fnds(i)%bout(ivar))
195 if (ivarout > nvarin)
call compute(c_funcbg(ivarout-nvarin),myout(:,ivarout))
201 vg6dout%voldati(:,:,ilevel,itime,itimerange,:)=reshape(myout,(/nx,ny,nvar/))
204 do ivar=1,
size(mayvfn%fnds(i)%bout)
205 do j=1,
size(mayvfn%fnds(i)%bin)
206 ivarin = index_c(mybin,mayvfn%fnds(i)%bin(j))
207 if (ivarin > 0) ivarin = index_c(newbout,mybin(ivarin))
210 if (ivarin == 0) ivarin=firsttrue(
c_e(vg6dout%gaid(ilevel,itime,itimerange,:)))
211 ivarout = index_c(newbout,mayvfn%fnds(i)%bout(ivar))
213 IF (ivarin > 0 .AND. ivarout > 0)
THEN
219 IF (ivarin /= ivarout) &
220 CALL copy(vg6dout%gaid(ilevel,itime,itimerange,ivarin), &
221 vg6dout%gaid(ilevel,itime,itimerange,ivarout))
223 #ifdef HAVE_LIBGRIBAPI
224 if (
c_e(grid_id_get_gaid(vg6dout%gaid(ilevel,itime,itimerange,ivarout))))
then
227 call grib_set(grid_id_get_gaid(vg6dout%gaid(ilevel,itime,itimerange,ivarout)),
"bitsPerValue",24)
240 if (.not. optio_log(allvarcomputed))
then
242 if (index_c(mybout,newbout(ivar)) <= 0)
then
245 do itimerange=1,ntimerange
246 call delete(vg6dout%gaid(ilevel,itime,itimerange,ivar))
256 deallocate (varv7d,varvg6d)
258 end subroutine make_vg6d
261 integer function alchemy_vg6dv(myin,vfn,mybout,myout,copy,vfnoracle,allvarcomputed)
263 character(len=*),
intent(in) :: mybout(:)
264 type(fndsv),
intent(in) :: vfn
265 type(volgrid6d),
intent(in) :: myin(:)
266 type(volgrid6d),
intent(out),
pointer ::myout(:)
267 logical,
intent(in),
optional :: copy
268 type(fndsv),
intent(out),
optional :: vfnoracle
269 logical,
optional :: allvarcomputed
272 type(fndsv) :: myvfn,vfntmp
273 character(len=10),
allocatable:: mybin(:)
274 TYPE(conv_func),
pointer :: c_func(:)
275 TYPE(vol7d_var),
allocatable :: varv7d(:)
279 allocate(myout(
size(myin)))
283 alchemy_vg6dv = alchemy(myin(i),vfn,mybout,myout(i),
copy,vfnoracle,allvarcomputed)
284 IF (alchemy_vg6dv /= 0)
RETURN
287 end function alchemy_vg6dv
289 integer function alchemy_vg6d(myin,vfn,mybout,myout,copy,vfnoracle,allvarcomputed)
291 character(len=*),
intent(in) :: mybout(:)
292 type(fndsv),
intent(in) :: vfn
293 type(volgrid6d),
intent(in) :: myin
294 type(volgrid6d),
intent(out) ::myout
295 logical,
intent(in),
optional :: copy
296 type(fndsv),
intent(out),
optional :: vfnoracle
297 logical,
optional :: allvarcomputed
300 type(fndsv) :: myvfn,vfntmp
301 character(len=10),
allocatable:: mybin(:)
302 TYPE(conv_func),
pointer :: c_func(:)
303 TYPE(vol7d_var),
allocatable :: varv7d(:)
308 allocate(varv7d(nvar))
309 CALL vargrib2varbufr(myin%var, varv7d, c_func)
316 mybin=varv7d(:)%btable
320 if (optio_log(
copy))
call register_copy(vfntmp,mybin)
324 call l4f_log(l4f_info,
"alchemy_vg6d: I have: "//mybin(j))
328 call l4f_log(l4f_info,
"alchemy_vg6d: To make: "//mybout(j))
331 if (.not. oracle(mybin,mybout,vfntmp,myvfn))
then
332 call l4f_log(l4f_warn,
"alchemy_vg6d: I cannot make your request")
334 if(.not. shoppinglist(mybout,vfntmp,myvfn,
copy=optio_log(
copy)))
then
335 call l4f_log(l4f_warn,
"shoppinglist: return error status")
338 if (
present(vfnoracle))vfnoracle=myvfn
342 if (
present(vfnoracle))vfnoracle=myvfn
345 call l4f_log(l4f_info,
"alchemy_vg6d: I need "//t2c(myvfn%nout)//
" more variables")
347 call make(myvfn,mybin,mybout,myin,myout, allvarcomputed)
352 end function alchemy_vg6d
354 end module volgrid6d_alchimia_class
Check missing values for fnds.
Make a deep copy, if possible, of the grid identifier.
Destructor, it releases every information and memory buffer associated with the object.
Constructor, it creates a new instance of the object.
This module defines objects and methods for generating derivative variables.
This module defines usefull general purpose function and subroutine.
This module defines an abstract interface to different drivers for access to files containing gridded...
Classe per la gestione delle variabili osservate da stazioni meteo e affini.
This module defines objects and methods for managing data volumes on rectangular georeferenced grids.
Class for managing physical variables in a grib 1/2 fashion.