libsim Versione 7.1.11
|
◆ oracle()
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
Definizione alla linea 536 del file alchimia.F03. 537order=order+1
538somefoundout = .false.
539
540CALL l4f_log(l4f_debug, "shoppinglist: order "//t2c(order))
541
542!search for functions outputing my output
543do 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
552end do
553
554!check if we can work anymore
555if (.not. somefoundout) return
556
557stat=shoppinglist(mybout,vfntmp,myvfn,copy=optio_log(copy), recurse=.true.)
558
559! delete on exit only on the main call
560if (.not. optio_log(recurse)) then
561 call delete(vfntmp)
562 order=0
563end if
564
565end function shoppinglist
566
567
570subroutine makev(mayvfn,mybin,mybout,myin,myout)
571type(fndsv),intent(inout) :: mayvfn
572character(len=*),intent(in) :: mybin(:)
573character(len=*),intent(in) :: mybout(:)
574real,intent(in) :: myin(:,:)
575real,intent(out) :: myout(:,:)
576integer :: i,j
577character(len=10) :: newbout(mayvfn%nout)
578
579
580newbout=cmiss
581do 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
591end do
592
593do 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
600end do
601
602!!$#include "arrayof_post.F90"
603
604end subroutine makev
605
606
607
608
610function compile_sl(myvfn)
611
612type(shoplists) :: compile_sl
613type(fndsv),intent(in) :: myvfn
614
615integer :: i,j,k,nshoplist,nvar,nfunc,indfunc,indvar
616CHARACTER(len=10),allocatable :: bvartmp(:)
617
618indfunc=0
619nshoplist=(maxval(myvfn%fnds(:)%order))
620nshoplist=max(0,nshoplist)
621allocate (compile_sl%shoplist(nshoplist))
622
623nvar=1
624
625do 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
648end do
649
650do i=1,nshoplist
651 compile_sl%shoplist(i)%bvar=pack(compile_sl%shoplist(i)%bvar,c_e(compile_sl%shoplist(i)%bvar))
652end do
653
654end function compile_sl
655
657
662
665
This module defines objects and methods for generating derivative variables. Definition: alchimia.F03:220 |