!+ ! Subroutine GROUP (IDUMMY, INGVAR, INGNUM, CMD0, DELTA) ! ! Subroutine to translate changes in group commands to actual changes in ! physical elements. A better version of this routine is GROUP_SET. ! ! Input: ! IDUMMY -- Integer: Not used. ! INGVAR -- Character*12: Name of ING node (e.g. 'CSR QTUNEING') ! INGNUM -- Integer: Element number of ING node ! CMD0 -- Integer: Current command of ING element. ! Read this with: CALL VMGCMD(INGVAR, INGNUM, INGNUM, CMD0) ! DELTA -- Integer: Wanted change in command. ! ! Output: ! DELTA -- Integer: Actual change in command. To update the ING element ! use: call vmputn(ingvar, ingnum, ingnum, cmd0+delta) ! ! ! To tell if a variable is a group knob: ! call vmwrmap(mnem, 1, 1, wrmap) ! int*4 wrmap ! if ((wrmap .and. '2000'x) /= 0) then ! yes it has group property ! call group..... ! ! To get just the info on a group (but not change anything) use the ! subroutine: SETUP_GROUP !- subroutine group (idummy, ingvar, ingnum, cmd0, delta) use mpm_utils_interface, dummy => group use MPMnet_mod implicit none type (group_info_struct) grp type (group_node) node integer:: k, n, nn, offset, target, idum, ret, iele integer:: ihigh(hard_maxx), ilow(hard_maxx), cu_old(300), cu_cmd(300) integer:: ingnum, cmd0, delta, idummy integer:: knobold, cu0, cu1, adj, inc, inc1, inc0, b, cut, iv0, iv1 integer:: inc_(ele_maxx),inc_one(ele_maxx),inc_tot(ele_maxx) integer:: cu_horz(120),cu_dipole !for dipole flux calc integer:: dcu_horz(120),dcu_dipole !for dipole flux calc integer:: dcu_mag(120),nsteps,step,max_delt,nel0,n1,n2,wrmode integer:: cmds(300), scs(300), diff(300) logical:: dip_ch_flux, is_chopper_type real:: coef,fdiv,fnc0,fnc1 character(12) ingvar logical ok, at_limit ! ret = vcbook_checked() ! if (ret .ne. 1) then ! print *, 'vcb00k_checked returned ', ret ! goto 888 ! endif ! call csr_sleep(100) ! ret = vcbook_checked() ! if (ret .ne. 1) then ! print *, '2nd vcb00k_checked returned ', ret ! goto 888 ! endif is_chopper_type = .false. ! setup group info if (delta == 0) return ! nothing to do idum = idummy ! so no complaints from compiler at_limit = .false. call setup_group (ingvar, ingnum, 0, 0, grp, ok, .false.) ! get old values if (grp%ratio_mode) then ret = vmgoldn(grp%ing_name, grp%ing_num, grp%ing_num, knobold) ! 'old' if (knobold == 0) return endif 1000 continue max_delt=0 !maximum change if (delta == 0) then ret = vmputn ('CSR PROGRMIN', 49, 49, node%ix_hard) ret = vmputn ('CSR PROGRMIN', 50, 50, n) call beep (10, 8, 2, 200) return endif cu0 = cmd0 ! current command cu1 = cmd0 + delta ! will be new command ! calculate increments and see if any past limit cu_horz=0 ret = vmgcmd('CSR BEND CUR',1,1,cu_dipole) !init flux calc dip_ch_flux=.false. inc_tot=0 !accum incs already done, to make last step exact do k = 1, grp%n_node ! loop over all nodes to be changed node = grp%node(k) if (grp%ratio_mode) ret = vmgoldn (node%name, 1, node%n_ele, cu_old) ret = vmgcmd (node%name, 1, node%n_ele, cu_cmd) if(node%name == 'CSR HORZ CUR') then dip_ch_flux=.true. cu_horz(1:98)=cu_cmd(1:98) elseif(node%name == 'CSR BEND CUR') then if (grp%ratio_mode.and.(cu_old(1) < 1000)) then call speech(' Dipole "old" is too low ') endif dip_ch_flux=.true. endif ilow(k) = 1 ihigh(k) = 0 do n = 1, node%n_ele nn = n + node%offset coef = grp%ele(nn)%coef if (coef == 0) then inc_(nn) = 0 else ! check if element is chopper type ret = vmgprpn (node%name, grp%ele(nn)%ix_ele, grp%ele(nn)%ix_ele, 15, wrmode) if (ret .ne. 1) then print *, 'vmgprpn failed' endif is_chopper_type = btest(wrmode,4) !.true. if has clock write ! Ratio mode: what is wanted is 1 unit of group will change each var by ! ratio = 1./(org knob) *coeff/1000 so if coeff = 1000 ! vars will change by same relative amount as knob itself. ! note coef already div by 1000 so 1000 in db = 1.0 if (grp%ratio_mode) then fdiv=coef/float(knobold) fnc0 = float((cu0-knobold) * cu_old(n)) fnc1 = float((cu1-knobold) * cu_old(n)) inc0 = nint(fnc0*fdiv) inc1 = nint(fnc1*fdiv) inc = inc1 - inc0 else inc0 = cu0 * coef inc1 = cu1 * coef inc = inc1 - inc0 if (grp%vernier_mode) then b = grp%ele(nn)%vern_base cut = grp%ele(nn)%vern_cut iv0 = cu0 * coef * b iv1 = cu1 * coef * b if (mod(abs(iv0), b) >= cut) inc = inc - sign(1, iv0) if (mod(abs(iv1), b) >= cut) inc = inc + sign(1, iv1) endif endif ! do zero cross correction here (only for some nodes) call cross_corr(node%name,cu_cmd(n),inc,adj,n,n) inc=adj inc_(nn) = inc max_delt=max(max_delt,abs(inc)) target = inc + cu_cmd(n) if(node%name == 'CSR HORZ CUR') then cu_horz(n)=target elseif(node%name == 'CSR BEND CUR') then cu_dipole=target endif if (target > grp%ele(nn)%up_lim) then if(inc == 0) then delta=0 !avoid div/0 below else delta = delta * (grp%ele(nn)%up_lim - cu_cmd(n)) / inc endif at_limit = .true. print *,' up lim ',target goto 1000 ! recompute everything elseif (target < grp%ele(nn)%dn_lim) then if(inc == 0) then delta=0 !avoid div/0 below else delta = delta * (grp%ele(nn)%dn_lim - cu_cmd(n)) / inc endif at_limit = .true. print *,' low lim ',target goto 1000 ! recompute everything endif endif if (inc_(nn) == 0) then if (ihigh(k) == 0) ilow(k) = n + 1 else ihigh(k) = n endif enddo enddo if(dip_ch_flux) then call horz_dipole_limits(cu_dipole,cu_horz,dcu_dipole,dcu_horz,dcu_mag) if(dcu_dipole >= 0) then print *, dcu_dipole,' dipole limit ' at_limit=.true. delta=0 goto 999 endif endif ! book the clock if chopper type ! if (is_chopper_type) then ! ret = vcbook_checked() ! if (ret .ne. 1) then ! delta=0 ! goto 888 ! endif ! endif ! put changes to data base if(grp%n_node.gt.1) then if (is_chopper_type) then ! only set to deferred mode if it needs the clock call vcmode('shortd') !defer changes till all set, but only allow 4k endif nsteps=1+ max_delt/4095 !Provide some slack else nsteps=1 !no need to divide into 4k steps endif do step=1,nsteps do k = 1, grp%n_node ! loop over all nodes to be changed offset = grp%node(k)%offset + ilow(k) nel0=ihigh(k)-ilow(k) !added needed to reach end ele if (ilow(k) <= ihigh(k)) then n1=offset ; n2=offset+nel0 if(step.lt.nsteps) then inc_one(n1:n2)=inc_(n1:n2)/nsteps !go part way, and accum change inc_tot(n1:n2)=inc_tot(n1:n2)+inc_one(n1:n2) !to avoid truncation elseif(nsteps.eq.1) then !no division into steps needed inc_one(n1:n2)=inc_(n1:n2) !go directly to end else !last of several steps inc_one(n1:n2)=inc_(n1:n2)-inc_tot(n1:n2) !Do remaining increment endif ret = vxincn (grp%node(k)%name, ilow(k), ihigh(k), inc_one(n1:n2)) if (ret .ne. 1) then print *,'vxincn returned ', ret goto 888 endif endif enddo if ((grp%n_node.gt.1) .and. (is_chopper_type)) then ret = vclogo_checked() ! run chopper clock, will free clock at end ! since it's in short deferred mode if (ret .ne. 1) then print *, 'vclogo returned ', ret goto 888 endif ! call vcwait !wait till done end if if (is_chopper_type) then ! check sc vs cmd after loading the changes do k = 1, grp%n_node ! loop over all nodes that were changed if (ilow(k) <= ihigh(k)) then ret = vmgcmd(grp%node(k)%name, ilow(k), ihigh(k), cmds) ret = vxgetn(grp%node(k)%name, ilow(k), ihigh(k), scs) if (ret < 0) cycle ! if there is an error reading cmd or sc, just skip it nel0 = ihigh(k) - ilow(k) + 1 ! diff(1:nel0) = abs(cmds(1:nel0) - scs(1:nel0)) do iele = 1, nel0 if (diff(iele) > 0 ) then print *, diff(iele), grp%node(k)%name, ilow(k)+iele-1, cmds(iele) end if ! if the difference is 1, then put the scalar as the command if (diff(iele) == 1) then ret = vmputn(grp%node(k)%name, ilow(k)+iele-1, ilow(k)+iele-1, scs(iele)) end if end do endif enddo endif enddo ! if (is_chopper_type) then ! call vcfree ! endif 999 if (at_limit) call beep (10, 8, 2, 100) 888 continue call vcmode('immed') return end subroutine group