libsim  Versione 7.1.7

◆ 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]vfnvector function object available
[in]mybinstandard table B description of input
[in]myboutstandard table B description of output
[out]myvfnvector function object that solve the problem
recurseset to .true. when called in recurse

Definizione alla linea 536 del file alchimia.F03.

537 order=order+1
538 somefoundout = .false.
539 
540 CALL l4f_log(l4f_debug, "shoppinglist: order "//t2c(order))
541 
542 !search for functions outputing my output
543 do i =1, count(c_e(vfntmp%fnds))
544  !call display(vfntmp%fnds(i))
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.
550  end if
551  end do
552 end do
553 
554 !check if we can work anymore
555 if (.not. somefoundout) return
556 
557 stat=shoppinglist(mybout,vfntmp,myvfn,copy=optio_log(copy), recurse=.true.)
558 
559 ! delete on exit only on the main call
560 if (.not. optio_log(recurse)) then
561  call delete(vfntmp)
562  order=0
563 end if
564 
565 end function shoppinglist
566 
567 
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(:,:)
576 integer :: i,j
577 character(len=10) :: newbout(mayvfn%nout)
578 
579 
580 newbout=cmiss
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)
587  end if
588  end if
589  end do
590  end if
591 end do
592 
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
596 
597  call mayvfn%fnds(i)%fn(mybin,newbout,mayvfn%fnds(i)%bin,mayvfn%fnds(i)%bout,myin,myout)
598  !print *,"make",i,mayvfn%fnds(i)%bin,mayvfn%fnds(i)%bout
599  end if
600 end do
601 
602 !!$#include "arrayof_post.F90"
603 
604 end subroutine makev
605 
606 
607 
608 
610 function compile_sl(myvfn)
611 
612 type(shoplists) :: compile_sl
613 type(fndsv),intent(in) :: myvfn
614 
615 integer :: i,j,k,nshoplist,nvar,nfunc,indfunc,indvar
616 CHARACTER(len=10),allocatable :: bvartmp(:)
617 
618 indfunc=0
619 nshoplist=(maxval(myvfn%fnds(:)%order))
620 nshoplist=max(0,nshoplist)
621 allocate (compile_sl%shoplist(nshoplist))
622 
623 nvar=1
624 
625 do i=1,nshoplist
626  nfunc=count(myvfn%fnds(:)%order==i)
627  allocate(compile_sl%shoplist(i)%bvar(nvar-1))
628  if (i > 1) then
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
634  end do
635  end do
636  end if
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)
644  nvar=nvar+1
645  end do
646  end do
647  indfunc=indfunc+nfunc
648 end do
649 
650 do i=1,nshoplist
651  compile_sl%shoplist(i)%bvar=pack(compile_sl%shoplist(i)%bvar,c_e(compile_sl%shoplist(i)%bvar))
652 end do
653 
654 end function compile_sl
655 
656 end module alchimia
657 
662 
665 
This module defines objects and methods for generating derivative variables.
Definition: alchimia.F03:220

Generated with Doxygen.