1 module vol7d_alchimia_class
13 module procedure make_v7d
17 module procedure alchemy_v7d
21 public make, alchemy, v7d_all_var, sl_display_pretty
26 function pretty_var(var)
27 CHARACTER(len=80) :: pretty_var
28 character(len=*) :: var
33 TYPE(vol7d_var
),
pointer,
save :: dballevar(:) => null()
35 call vol7d_dballe_import_dballevar(dballevar)
36 ind=index_c(dballevar(:)%btable,var)
39 pretty_var=dballevar(ind)%description
48 end function pretty_var
51 subroutine make_v7d(mayvfn,mybin,mybout,v7din,v7dout)
52 type(fndsv),
intent(inout) :: mayvfn
53 character(len=*),
intent(in) :: mybin(:),mybout(:)
54 type(vol7d),
intent(inout) :: v7din
55 type(vol7d),
intent(out) :: v7dout
56 integer :: i,j,nana,nlevel,ntime,ntimerange,nvarin,nvarout,nnetwork
57 integer :: ilevel,itime,itimerange,inetwork,ivar,ind,ivarin,ivarout
58 type(vol7d_var
) :: var
59 character(len=1) :: type
60 character(len=10) :: newbout(mayvfn%nout+mayvfn%nin)
63 ntime=
size(v7din%time)
64 nlevel=
size(v7din%level)
65 ntimerange=
size(v7din%timerange)
66 nnetwork=
size(v7din%network)
68 call
copy(v7din,v7dout,&
69 ldativarr=(/.false./),&
70 ldativari=(/.false./),&
71 ldativard=(/.false./),&
72 ldativarb=(/.false./),&
73 ldativarc=(/.false./))
80 do i=1,
size(mayvfn%fnds)
81 if (
c_e(mayvfn%fnds(i)))
then
82 do j=1,
size(mayvfn%fnds(i)%bin)
83 if (
c_e(mayvfn%fnds(i)%bin(j)))
then
84 if (index_c(mybin,mayvfn%fnds(i)%bin(j)) <= 0)cycle
85 if (index_c(newbout,mayvfn%fnds(i)%bin(j)) <= 0)
then
86 newbout(index_c(newbout,cmiss)) = mayvfn%fnds(i)%bin(j)
93 nvarin=count(
c_e(newbout))
96 do i=1,
size(mayvfn%fnds)
97 if (
c_e(mayvfn%fnds(i)))
then
98 do j=1,
size(mayvfn%fnds(i)%bout)
99 if (
c_e(mayvfn%fnds(i)%bout(j)))
then
100 if (index_c(newbout,mayvfn%fnds(i)%bout(j)) <= 0)
then
101 newbout(index_c(newbout,cmiss)) = mayvfn%fnds(i)%bout(j)
108 nvarout=count(
c_e(newbout))
110 call vol7d_alloc(v7dout, ndativarr=nvarout)
113 call
init(v7dout%dativar%r(ivar),btable=newbout(ivar))
116 call vol7d_alloc_vol(v7dout,inivol=.true.)
123 ivarin = index_c(mybin,newbout(ivar))
126 call
init(var, btable=newbout(ivarout))
129 ind =
index(v7din%dativar, var, type=type)
134 v7dout%voldatir(:,:,:,:,ivarout,:)= &
135 realdat(v7din%voldatid(:,:,:,:,ind,:),v7din%dativar%d(ind))
137 v7dout%voldatir(:,:,:,:,ivarout,:)= &
138 realdat(v7din%voldatir(:,:,:,:,ind,:),v7din%dativar%r(ind))
140 v7dout%voldatir(:,:,:,:,ivarout,:)= &
141 realdat(v7din%voldatii(:,:,:,:,ind,:),v7din%dativar%i(ind))
143 v7dout%voldatir(:,:,:,:,ivarout,:)= &
144 realdat(v7din%voldatib(:,:,:,:,ind,:),v7din%dativar%b(ind))
146 v7dout%voldatir(:,:,:,:,ivarout,:)= &
147 realdat(v7din%voldatic(:,:,:,:,ind,:),v7din%dativar%c(ind))
150 v7dout%voldatir(:,:,:,:,ivarout,:)=rmiss
156 do i=
size(mayvfn%fnds),1,-1
157 if (
c_e(mayvfn%fnds(i)) .and. .not. match(mayvfn%fnds(i)%name,
"copy*") )
then
160 call l4f_log(l4f_debug,
"execute function: "//mayvfn%fnds(i)%name)
165 do itimerange=1,ntimerange
166 do inetwork=1,nnetwork
167 call mayvfn%fnds(i)%fn(newbout,newbout,mayvfn%fnds(i)%bin,mayvfn%fnds(i)%bout,&
168 v7dout%voldatir(:,itime,ilevel,itimerange,:,inetwork),&
169 v7dout%voldatir(:,itime,ilevel,itimerange,:,inetwork))
178 end subroutine make_v7d
181 subroutine v7d_all_var(myin,mybin)
183 type(vol7d),
intent(in) :: myin
184 character(len=10),
allocatable:: mybin(:)
185 integer :: nbin,nbinn
189 if (
associated(myin%dativar%r)) nbin = nbin +
size(myin%dativar%r)
190 if (
associated(myin%dativar%i)) nbin = nbin +
size(myin%dativar%i)
191 if (
associated(myin%dativar%d)) nbin = nbin +
size(myin%dativar%d)
192 if (
associated(myin%dativar%b)) nbin = nbin +
size(myin%dativar%b)
193 if (
associated(myin%dativar%c)) nbin = nbin +
size(myin%dativar%c)
195 allocate (mybin(nbin))
198 if (
associated(myin%dativar%r))
then
199 nbinn=nbin+
size(myin%dativar%r)
200 mybin(nbin+1:nbinn) = myin%dativar%r(:)%btable
204 if (
associated(myin%dativar%i))
then
205 nbinn=nbin+
size(myin%dativar%i)
206 mybin(nbin+1:nbinn) = myin%dativar%i(:)%btable
210 if (
associated(myin%dativar%d))
then
211 nbinn=nbin+
size(myin%dativar%d)
212 mybin(nbin+1:nbinn) = myin%dativar%d(:)%btable
216 if (
associated(myin%dativar%b))
then
217 nbinn=nbin+
size(myin%dativar%b)
218 mybin(nbin+1:nbinn) = myin%dativar%b(:)%btable
222 if (
associated(myin%dativar%c))
then
223 nbinn=nbin+
size(myin%dativar%c)
224 mybin(nbin+1:nbinn) = myin%dativar%c(:)%btable
228 end subroutine v7d_all_var
231 integer function alchemy_v7d(myin,vfn,mybout,myout,copy,vfnoracle)
233 character(len=10),
intent(in) :: mybout(:)
234 type(fndsv),
intent(in) :: vfn
235 type(vol7d),
intent(inout) :: myin
236 type(vol7d),
intent(out) :: myout
237 logical,
intent(in),
optional ::
copy
238 type(
fndsv),
intent(out),
optional :: vfnoracle
241 type(fndsv) :: vfntmp, myvfn
242 character(len=10),
allocatable:: mybin(:)
246 call v7d_all_var(myin,mybin)
249 if (optio_log(
copy)) call register_copy(vfntmp,mybin)
252 call l4f_log(l4f_info,
"alchemy_v7d: I have: "//mybin(i))
256 call l4f_log(l4f_info,
"alchemy_v7d: To make: "//mybout(i))
259 if (.not. oracle(mybin,mybout,vfntmp,myvfn))
then
260 call l4f_log(l4f_warn,
"alchemy_v7d: I cannot make your request")
262 if(.not. shoppinglist(mybout,vfntmp,myvfn,
copy=optio_log(
copy)))
then
263 call l4f_log(l4f_warn,
"shoppinglist: return error status")
266 if (present(vfnoracle)) vfnoracle=myvfn
270 if (present(vfnoracle)) vfnoracle=myvfn
273 call l4f_log(l4f_info,
"alchemy_v7d: I need "//
t2c(myvfn%nout)//
" variables")
275 call make(myvfn,mybin,mybout,myin,myout)
280 end function alchemy_v7d
284 subroutine sl_display_pretty(sl)
289 do i = 1,
size(sl%shoplist)
290 print *,
"shopping list : ",i
291 do j=1,
size(sl%shoplist(i)%bvar)
292 print *,
"required var : ",sl%shoplist(i)%bvar(j),
" -> ",pretty_var(sl%shoplist(i)%bvar(j))
297 end subroutine sl_display_pretty
300 end module vol7d_alchimia_class
Functions that return a trimmed CHARACTER representation of the input variable.
Vector of function to transform the input to alchimia module.
Vector of shoplists that are list of variables.
Classe per la gestione di un volume completo di dati osservati.
Distruttori per le 2 classi.
Definisce un oggetto contenente i volumi anagrafica e dati e tutti i descrittori delle loro dimension...
Costruttori per le classi datetime e timedelta.
This module defines objects and methods for generating derivative variables.
Copy an object, creating a fully new instance.
classe per import ed export di volumi da e in DB-All.e
classe per la gestione del logging