libsim Versione 7.1.11
|
◆ fnregister()
Register a function object in the vector function object. If called without argoments allocate vectors to (0) if order is present force the order of added function
Definizione alla linea 395 del file alchimia.F03. 396 CALL l4f_log(l4f_debug, "oracle: register "//trim(vfn%fnds(i)%name))
397 call fnregister(maybefn,vfn%fnds(i),order)
398 do k=1,size(vfn%fnds(i)%bout)
399 tmpbin(firsttrue(.not. c_e(tmpbin)))=vfn%fnds(i)%bout(k)
400 newbout(firsttrue(.not. c_e(newbout)))=vfn%fnds(i)%bout(k)
401 end do
402 somefoundin = .true.
403 end if
404end do
405
406do i = 1, count(c_e(tmpbin))
407 newbin(firsttrue(.not. c_e(newbin)))=tmpbin(i)
408end do
409
410! here bin and bout are bigger (newbin, newbout)
411! by the output of applicable functions
412
413
414!check if we can work anymore
415stat = .false.
416if (.not. somefoundin) return
417if (num == count(c_e(maybefn%fnds))) return
418
419!check if we have finish
420allfoundout = .true.
421do i=1, count(c_e(mybout))
422 foundout = .false.
423 do j =1, count(c_e(newbout))
424 if (newbout(j) == mybout(i)) foundout = .true.
425 end do
426 if (.not. foundout) allfoundout = .false.
427end do
428
429
430! ok, all is done
|