|
◆ oracle()
recursive logical function oracle |
( |
character(len=*), dimension(:), intent(in) |
mybin, |
|
|
character(len=*), dimension(:), intent(in) |
mybout, |
|
|
type(fndsv), intent(in) |
vfn, |
|
|
type(fndsv), intent(out) |
myvfn, |
|
|
logical, optional |
recurse |
|
) |
| |
This function like a oracle say you how to abtain what you want.
Starting from desciption of input and output and a vector of available functions provide to you the road to execute for make the output - Parametri
-
[in] | vfn | vector function object available |
[in] | mybin | standard table B description of input |
[in] | mybout | standard table B description of output |
[out] | myvfn | vector function object that solve the problem |
| recurse | set to .true. when called in recurse |
Definizione alla linea 536 del file alchimia.F03.
538 somefoundout = .false.
540 CALL l4f_log(l4f_debug, "shoppinglist: order "//t2c(order))
543 do i =1, count(c_e(vfntmp%fnds))
545 do j = 1, count(c_e(vfntmp%fnds(i)%bout(:)))
546 if (any(vfntmp%fnds(i)%bout(j) == newbout)) then
547 CALL l4f_log(l4f_debug, "shoppinglist: register "//trim(vfntmp%fnds(i)%name))
548 call fnregister(myvfn,vfntmp%fnds(i),order)
549 somefoundout = .true.
555 if (.not. somefoundout) return
557 stat=shoppinglist(mybout,vfntmp,myvfn,copy=optio_log(copy), recurse=.true.)
560 if (.not. optio_log(recurse)) then
565 end function shoppinglist
570 subroutine makev(mayvfn,mybin,mybout,myin,myout)
571 type(fndsv), intent(inout) :: mayvfn
572 character(len=*), intent(in) :: mybin(:)
573 character(len=*), intent(in) :: mybout(:)
574 real, intent(in) :: myin(:,:)
575 real, intent(out) :: myout(:,:)
577 character(len=10) :: newbout(mayvfn%nout)
581 do i=1, size(mayvfn%fnds)
582 if (c_e(mayvfn%fnds(i))) then
583 do j=1, size(mayvfn%fnds(i)%bout)
584 if (c_e(mayvfn%fnds(i)%bout(j))) then
585 if (index_c(newbout,mayvfn%fnds(i)%bout(j)) <= 0) then
586 newbout(index_c(newbout,cmiss)) = mayvfn%fnds(i)%bout(j)
593 do i= size(mayvfn%fnds),1,-1
594 if (c_e(mayvfn%fnds(i))) then
595 print *, "name:",mayvfn%fnds(i)%name, "order:",mayvfn%fnds(i)%order
597 call mayvfn%fnds(i)%fn(mybin,newbout,mayvfn%fnds(i)%bin,mayvfn%fnds(i)%bout,myin,myout)
610 function compile_sl(myvfn)
612 type(shoplists) :: compile_sl
613 type(fndsv), intent(in) :: myvfn
615 integer :: i,j,k,nshoplist,nvar,nfunc,indfunc,indvar
616 CHARACTER(len=10), allocatable :: bvartmp(:)
619 nshoplist=(maxval(myvfn%fnds(:)%order))
620 nshoplist=max(0,nshoplist)
621 allocate (compile_sl%shoplist(nshoplist))
626 nfunc=count(myvfn%fnds(:)%order==i)
627 allocate(compile_sl%shoplist(i)%bvar(nvar-1))
629 compile_sl%shoplist(i)%bvar = compile_sl%shoplist(i-1)%bvar
630 do j = indfunc+1, indfunc+nfunc
631 do k = 1, size(myvfn%fnds(j)%bout)
632 indvar=index_c(compile_sl%shoplist(i)%bvar,myvfn%fnds(j)%bout(k))
633 if (indvar > 0) compile_sl%shoplist(i)%bvar(indvar)=cmiss
637 do j = indfunc+1, indfunc+nfunc
638 do k = 1, size(myvfn%fnds(j)%bin)
639 if (index_c(compile_sl%shoplist(i)%bvar,myvfn%fnds(j)%bin(k)) > 0 ) cycle
640 allocate(bvartmp(nvar))
641 bvartmp(:nvar-1)=compile_sl%shoplist(i)%bvar
642 call move_alloc(from=bvartmp ,to=compile_sl%shoplist(i)%bvar)
643 compile_sl%shoplist(i)%bvar(nvar)=myvfn%fnds(j)%bin(k)
647 indfunc=indfunc+nfunc
651 compile_sl%shoplist(i)%bvar=pack(compile_sl%shoplist(i)%bvar,c_e(compile_sl%shoplist(i)%bvar))
654 end function compile_sl
This module defines objects and methods for generating derivative variables.
|