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)
285 type(shoplists),
intent(in) :: 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
Distruttore per la classe vol7d.
classe per import ed export di volumi da e in DB-All.e
Costruttore per la classe vol7d.
Test for a missing volume.
This module defines objects and methods for generating derivative variables.
Classe per la gestione di un volume completo di dati osservati.
classe per la gestione del logging