|
◆ 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 556 del file alchimia.F03.
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 668 This module defines objects and methods for generating derivative variables.
|