21 module volgrid6d_alchimia_class
33 module procedure make_vg6d
37 module procedure 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)
72 do i=1,
size(mayvfn%fnds)
73 if (
c_e(mayvfn%fnds(i)))
then 74 do j=1,
size(mayvfn%fnds(i)%bin)
75 if (
c_e(mayvfn%fnds(i)%bin(j)))
then 76 if (index_c(mybin,mayvfn%fnds(i)%bin(j)) == 0)cycle
77 if (index_c(newbout,mayvfn%fnds(i)%bin(j)) <= 0)
then 78 newbout(index_c(newbout,cmiss)) = mayvfn%fnds(i)%bin(j)
85 nvarin=count(
c_e(newbout))
88 do i=1,
size(mayvfn%fnds)
89 if (
c_e(mayvfn%fnds(i)))
then 90 do j=1,
size(mayvfn%fnds(i)%bout)
91 if (
c_e(mayvfn%fnds(i)%bout(j)))
then 92 if (index_c(newbout,mayvfn%fnds(i)%bout(j)) <= 0)
then 93 newbout(index_c(newbout,cmiss)) = mayvfn%fnds(i)%bout(j)
101 nvar=count(
c_e(newbout))
103 allocate(myout(nx*ny,nvar))
106 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 121 call l4f_log(l4f_debug,
"variable to compute in make_vg6d: "//newbout(ivar))
125 varvg6d(ivarout)=vg6din%var(ivarin)
126 call init(gaid_template)
130 do itimerange=1,ntimerange
131 if ( .not.
ASSOCIATED(vg6din%voldati))
then 133 CALL grid_id_decode_data(vg6din%gaid(ilevel,itime,itimerange,ivarin),&
134 vg6dout%voldati(:,:,ilevel,itime,itimerange,ivarout))
136 vg6dout%voldati(:,:,ilevel,itime,itimerange,ivarout)=vg6din%voldati(:,:,ilevel,itime,itimerange,ivarin)
139 call copy (vg6din%gaid(ilevel,itime,itimerange,ivarin), vg6dout%gaid(ilevel,itime,itimerange,ivarout))
141 IF (.NOT.
c_e(gaid_template) .AND. &
142 c_e(vg6din%gaid(ilevel,itime,itimerange,ivarin))) &
143 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 call copy (vg6dout%gaid(ilevel,itime,itimerange,ivarin), vg6dout%gaid(ilevel,itime,itimerange,ivarout))
221 #ifdef HAVE_LIBGRIBAPI 222 if (
c_e(grid_id_get_gaid(vg6dout%gaid(ilevel,itime,itimerange,ivarout))))
then 225 call grib_set(grid_id_get_gaid(vg6dout%gaid(ilevel,itime,itimerange,ivarout)),
"bitsPerValue",24)
238 if (.not. optio_log(allvarcomputed))
then 240 if (index_c(mybout,newbout(ivar)) <= 0)
then 243 do itimerange=1,ntimerange
244 call delete(vg6dout%gaid(ilevel,itime,itimerange,ivar))
254 deallocate (varv7d,varvg6d)
256 end subroutine make_vg6d
259 integer function alchemy_vg6d(myin,vfn,mybout,myout,copy,vfnoracle,allvarcomputed)
261 character(len=*),
intent(in) :: mybout(:)
262 type(fndsv),
intent(in) :: vfn
263 type(volgrid6d),
intent(in) :: myin(:)
264 type(volgrid6d),
intent(out),
pointer ::myout(:)
265 logical,
intent(in),
optional :: copy
266 type(fndsv),
intent(out),
optional :: vfnoracle
267 logical,
optional :: allvarcomputed
270 type(fndsv) :: myvfn,vfntmp
271 character(len=10),
allocatable:: mybin(:)
272 TYPE(conv_func),
pointer :: c_func(:)
273 TYPE(vol7d_var),
allocatable :: varv7d(:)
277 allocate(myout(
size(myin)))
281 nvar=
size(myin(i)%var)
282 allocate(varv7d(nvar))
283 CALL vargrib2varbufr(myin(i)%var, varv7d, c_func)
290 mybin=varv7d(:)%btable
294 if (optio_log(
copy))
call register_copy(vfntmp,mybin)
298 call l4f_log(l4f_info,
"alchemy_vg6d: I have: "//mybin(j))
302 call l4f_log(l4f_info,
"alchemy_vg6d: To make: "//mybout(j))
305 if (.not. oracle(mybin,mybout,vfntmp,myvfn))
then 306 call l4f_log(l4f_warn,
"alchemy_vg6d: I cannot make your request")
308 if(.not. shoppinglist(mybout,vfntmp,myvfn,
copy=optio_log(
copy)))
then 309 call l4f_log(l4f_warn,
"shoppinglist: return error status")
312 if (
present(vfnoracle))vfnoracle=myvfn
316 if (
present(vfnoracle))vfnoracle=myvfn
319 call l4f_log(l4f_info,
"alchemy_vg6d: I need "//t2c(myvfn%nout)//
" more variables")
321 call make(myvfn,mybin,mybout,myin(i),myout(i), allvarcomputed)
331 end function alchemy_vg6d
333 end module volgrid6d_alchimia_class
Constructor, it creates a new instance of the object.
Destructor, it releases every information and memory buffer associated with the object.
This module defines an abstract interface to different drivers for access to files containing gridded...
This module defines objects and methods for managing data volumes on rectangular georeferenced grids...
Classe per la gestione delle variabili osservate da stazioni meteo e affini.
This module defines objects and methods for generating derivative variables.
This module defines usefull general purpose function and subroutine.
Make a deep copy, if possible, of the grid identifier.
Check missing values for fnds.
Class for managing physical variables in a grib 1/2 fashion.