C********************************************************************** C rtc.f nstx power supply real time control program C C REVISONS: C -------- C 07/14/05 c.neumeyer Fixed display logic for elevated temperatures C 06/15/05 c.neumeyer Modified tbdelay to allow 15 degree margin C 05/10/05 c.neumeyer Fault all OH and PF for OH or PF ILOC or Fz fault C 03/02/05 c.neumeyer Add axial force and tf joint calcs (v6) C 04/28/04 t.gibney Eliminate CHI-specific code. C 03/23/04 t.gibney Expand usage of nerracq to include IEEE "NaN" req C from PCS. C 01/12/04 t.gibney rtc: call set_idl_info (for IDL uif) when in C standby mode. C 11/21/03 t.gibney faultlogic: set nfaultFlag for use by outdat (had C been checking nfcount, which is both alrms+faults) C 11/11/03 t.gibney save_rtc_data: use nsaveFlag etc to regulate when C high-speed data are saved for d.o file. Default C is to save data at one-millisecond rate. C 07/28/03 t.gibney Change from double-precision to single-precision. C 01/27/03 t.gibney rtc_timestep: check nerracq for data-acq error. C 12/12/02 t.gibney chiimintest: use ichi0, not hard-coded IMINCHI. C 08/05/01 t.gibney chiarcdetector: revise logic for setting nchiblock. C 08/03/01 t.gibney tfforecast: actually new chi arc detector code. C Might be moved to within chiarcdetector rtn? C 07/03/01 t.gibney Set nclamp() for either v0max or icln-to-iclp cases. C 06/27/01 t.gibney chiarcdetector revised: look for TF fluctuations. C 10/25/00 t gibney use parameters for NBRANCHES, NCOILS, etc. C 05/25/00 t.gibney Revise "amax" constraint for CHI. C Remove structure refs, compatible with gnu fortran. C 01/10/00 t.gibney Add chiarcdetector: chi arc checking. C 11/19/99 t.gibney pscontrol: enable integral correction based on ienb. C 10/14/99 t.gibney pscontrol: change napon to nap (noted in code) C 07/16/99 t.gibney faultlogic: revise calculation of tbdelay, per cn. C 05/17/99 t.gibney pscontrol: change logic determining vcomm(n). C 04/15/99 t.gibney Fix minor bug in pscontrol. C 04/12/99 t.gibney Move HCS check inside rtc subroutine. C New subroutines save_rtc_data and write_rtc_data, C performing duties formerly done in-line. C 02/18/99 t.gibney Create separate, much smaller main program in C separate file rtc_main.f. Move code from old main C to new subroutines reset_standby, rtc_timestep C and displayTemperatures. C 01/10/99 c neumeyer Added resets+reinitializations when pulse finished, C added block bypass command in pscontrol C 01/08/99 t.gibney Call outdat at top to start standby vme output C 01/06/99 t.gibney Change usage of nselectreal and nselectint. C 12/29/98 t.gibney Open d.o here, rather than in rtc_init. C 12/23/98 t.gibney Avoid overflow of "save" array boundary. C 12/02/98 c neumeyer added fixes during PTP-ECS-034 C 11/29/98 c neumeyer modifications for coil temp sim, fault log, display C 11/17/98 c neumeyer modifications for collected data C 11/06/98 c neumeyer added polarity sensitivity to TF/CHI interlock C 10/21/98 c neumeyer various post FDR fixes C 10/04/98 c neumeyer various fixes in preparation for FDR C 09/16/98 b davis bug fix in build call. Calls to dtime. C 09/09/98 c neumeyer C********************************************************************** !!! NOTE: source file for main routine: rtc_main.f SUBROUTINE show_faults IMPLICIT NONE include 'rtcdef.inc' integer n 994 format(i3,2x,a36,a6,1pG10.3,0pF7.3) if (nfcount.GT.0) then do n=1,nfcount write(6,994)n,f(n),fcircuit(n),fvalue(n),ftime(n) enddo endif return end C********************************************************************* SUBROUTINE fault_nerracq(t) C********************************************************************* IMPLICIT NONE !Parameters real*4 t !Local variables include 'rtcdef.inc' integer n !Format statements 113 format(/T27,'*ERROR* Data Acq fault or timeout t=',f7.3,/T28,A) if (nfault(IDX_PF4,1) .EQ. 0) then !use any nfault(*,1) entry nfcount=nfcount+1 if(nfcount.gt.100)nfcount=1 if (iand(nerracq,'0004'X).NE.0) then f(nfcount)='Fault: Data Acq TIMEOUT' else if (iand(nerracq,'0008'X).NE.0) then f(nfcount)='Fault: Data Acq SYNC error' else if (iand(nerracq,'0010'X).NE.0) then f(nfcount)='Fault: PCS ReqVoltage NaN' else f(nfcount)='Fault: Data Acq Error (non-specific)' endif fcircuit(nfcount)='--All--' fvalue(nfcount)=0.0 ftime(nfcount)=t write(6,113) t,f(nfcount) do n=1,NCOILS call faultlogic(n,t) !Fault all circuits ... enddo endif end C********************************************************************** SUBROUTINE rtc_timestep(t) !Outer routine, called for each timestep ! in both standby and pulse modes C********************************************************************** IMPLICIT NONE !Arguments: !--------- real*4 t ! time for this pass !Common Blocks: !------------- include 'rtcdef.inc' include 'nstx_savedata.inc' include 'pcs_common.inc' !External functions: !------------------ integer get_nreset !Get "nreset" from rtc/host comm buffer integer set_nreset !Set "nreset" in rtc/host comm buffer !Local Variables: !--------------- INTEGER nsopeopB4 INTEGER n REAL*4 dtsave REAL*4 dtstandby,etstandby data nsopeopB4/-1/, dtsave/0.0/ !Format statements !----------------- 100 format(A,' _______________________________________') 102 format('--> reset completed'//) 110 format(' Error: Pulse Aborted Due to Outstanding Alarms/Faults', % 2x,F10.3,3x,I5) 112 format(T40,'!! Awaiting Fault/Alarm Reset !!',/) !Executable code: !--------------- if (nsopeop.ne.nsopeopB4) then write(6,*) write(6,*) 'nsopeop =',nsopeop,' t =',t,' nshot =',nshot nsopeopB4 = nsopeop !!! call show_aomeas endif C C convert measurements to engineering units with proper polarity C C C das is bit count from DAS C aomeas is average offset measured during standby (npulse=0), C subtracted only during pulse (npulse=1) C kmeas is scaling C !!! DO 286, n = 1,NBRANCHES !!! DO 285, n1 = 1,2 !!! nn = nmeas(n,n1) !!! if (npulse.ne.0) then !!! imeas(nn) = das(nn)*kmeas(n,n1)-aomeas(n,n1) !!! else !!! imeas(nn) = das(nn)*kmeas(n,n1) !!! endif !!!285 CONTINUE !!!286 CONTINUE !imeas now filled in directly from rtc_indat !Check nerracq -- set upon data acq timeout ! or if shm->nerracqOutOfSync is set !------------------------------------------ if (nerracq .NE. 0) then call fault_nerracq(t) endif nclampm = 0 IF (npulse.eq.0)THEN !------------ standby state ... dtstandby=dtstandby+dt etstandby=etstandby+dt if(dtstandby.ge.5.)then C C refresh display C write(6,100) char(13) write(6,1) etstandby 1 format(1x,'Elapsed time in standby ',1f8.2,/) call displayTemperatures('') IF(get_nreset().eq.1)THEN C C reset faults and call rtc_init C DO 290 n=1,NCOILS nfault(n,1)=0 nfault(n,2)=0 290 CONTINUE nfcount=0 nfaultFlag=0 nerracq=0 n = set_nreset(0) !reset value in rtc/host comm buf dtsave = dt !because dt gets set to 1.e-3 in rtc_init call rtc_init dt = dtsave write(6,102) ELSE IF(nfcount.ne.0)THEN C C faults are outstanding C C C psrtc is in alarm or fault state, awaiting reset C write(6,112) ! Awaiting Fault/Alarm Reset ENDIF dtstandby=0. endif CALL standbycurrent C C Pulse On/Off Control C IF (nsopeop.eq.1) THEN C C within sop/eop interval C IF(t.ge.tmin.and.t-dt.lt.tmin)THEN C C Just passed scheduled pulse start time C C Start pulse if faults are clear C IF(nfcount.eq.0)THEN npulse=1 !!! nchi_imin_done = 0 !!! nchi_imin_started = 0 !!! call pc_setv !pacify pcs, if it's waiting write(6,*) write(6,*) 'npulse = 1' nstep = 0 call profile_clear !Clear profile statistics, enable ELSE C C reset not received in time for schedule pulse C write(6,110) t,nfcount ENDIF ENDIF ENDIF call set_idl_info !Set IDL uif info during stby ... ELSE !..else npulse.eq.1 ... !------------ pulse is underway call profile_update(0,'npulse.EQ.1 *top*') call rtc(t) IF (nsubmode.EQ.0) THEN !.. perform i/o functions CALL outdat ENDIF !!! CALL pc_setv !Set actual voltages for plasmacontrol (pcs) call save_rtc_data(t) !save selected data for file output call profile_update(49,'npulse.EQ.1 *end*') !Check nerracq -- set if rtc_plasmacontrol ! detected IEEE "NaN" voltageRequest !------------------------------------------ if (nerracq .NE. 0) then call fault_nerracq(t) endif if (t.ge.tmax .or. nerracq.ne.0) then C C Pulse has just finished /////////////////////////////////////////// C npulse=0 call profile_onoff(0) !disable profiling ... if (nsubmode.eq.1) then !simulation mode only ... nsopeop = 0 endif C C reset control for standby state and reinitialize C call reset_standby write(6,*) write(6,*) 'npulse = 0' call shot_summary !!! call chiarc_init C C write saved collected data to file C call write_rtc_data if (npcsTest .OR. nsubmode.eq.1) then call pscExit(0,'Exiting from test/simulation mode') endif C nstep=0 dtstandby=0. etstandby=0. call displayTemperatures('EOP ') ENDIF !---------> end of pulse steps completed ENDIF return END C********************************************************************** SUBROUTINE displayTemperatures(txt) C********************************************************************** IMPLICIT NONE !Arguments: !--------- character*(*) txt !optional extra text !Common Blocks: !------------- include 'rtcdef.inc' !Local Variables: !--------------- integer n character*24 dummy !Format statements !----------------- 101 format(2A) 1101 format(3x,a8,1f8.1,' .GT.',f6.1) 1201 format(3x,a8,1f8.1,' .GT.',f6.1) !Executable code: !--------------- write(6,*) write(6,101) txt,'Elevated Coil Temperatures (deg C)' do 1100 n=1,NCOILS C C skip when temperature falls within 1C of starting temp C if(tcoil(n).le.t0coil(n)+1.0)go to 1100 write(6,1101)circuitname(n),tcoil(n),t0coil(n) 1100 continue write(6,*) write(6,101) txt,'Elevated Pole Temperatures (deg C)' do 1200 n=1,NPOLES C C skip when temperature falls within 1C of starting temp C if(tpole(n).le.t0pole+1.0)go to 1200 if(npsum(n,1).ne.0.and.npsum(n,2).ne.0)then dummy='MIDPOINT' else dummy=circuitname(npsum(n,1)) endif write(6,1201)dummy,tpole(n),t0pole 1200 continue return end C********************************************************************** SUBROUTINE reset_standby C********************************************************************** IMPLICIT NONE !Arguments: !--------- !none !Common Blocks: !------------- include 'rtcdef.inc' !Local Variables: !--------------- integer n integer napblockinit(NCOILS) !Initial value of napblock logical first data first/.TRUE./ !!! volatile napblockinit,first data napblockinit /NCOILS*0/ !Executable code: !--------------- if (first) then first = .FALSE. do n=1,NCOILS napblockinit(n) = napblock(n) !save initial values enddo endif do 975 n=1,NCOILS napblock(n)=napblockinit(n) ndat(n) = 1 vprtc(n) = 0. nclamp(n) = 0 iload(n) = 0. intierr(n) = 0. i2t(n) = 0. IF (nap(n).EQ.1) THEN if(napblock(n).eq.0)then napon(n)=1 else napon(n)=0 end if ELSE napon(n) = 0 ENDIF a1(n) = astdby(n) if(n.ne.IDX_RWM1)then a2(n) = astdby(n) else C C special treatment for p13 C a2(n)= 165.*pi/180. end if a1old(n) = a1(n) !a1old is set same as astby a2old(n) = a2(n) !a2old " " " " " ncvt1(n) = 0 ncvt2(n) = 0 nbb(n) = 0 975 continue if (nsubmode.eq.0) then call outdat !Start writing standby alphas ... endif !!! CALL pc_setv !Set actual voltages for plasmacontrol (pcs) return end ********************************************************************* SUBROUTINE pulsecurrent(t) ********************************************************************* C C determine branch and load currents from measurements C check for dcct discrepancies C check for overcurrents C check for i2t overloads C simulate coil temperature rises C simulate pole temperature rises C IMPLICIT NONE !Arguments: !--------- REAL*4 t !Common Blocks: !------------- include 'rtcdef.inc' !Local Variables: !--------------- integer n,nn,nturns,nx real*4 di real*4 f1b,f2b,f3b,f1bip,f1boop real*4 fbundle,flateral,fmbundle,ftfj,fv(NFV) real*4 i,i1,i2 real*4 iin,iout,ipole,itf6kg real*4 mbundle,mlateral,mtfjip6kg,mtfjloip,mtfjlooop real*4 ptfjavg,ptfjip,ptfjoop real*4 rbundle,rlateral C C set load current sums to zero C DO 50, n = 1,NCOILS iload(n) = 0. 50 CONTINUE C C loop through branches, check for overcurrents, sum up load currrents C DO 100, n = 1,NBRANCHES C C skip branches with multiplier set to zero C IF (kpb(n).EQ.0) GOTO 100 C C skip locked out circuits C IF (nlock(ncb(n)).EQ.1) GOTO 100 C C compare redundant measurements of branch current C i1 = imeas(nmeas(n,1)) i2 = imeas(nmeas(n,2)) di = abs(i1-i2) IF (di.GT.dimax(n)) THEN IF (nfault(ncb(n),2).NE.1) THEN C C dcct discrepancy C nfcount=nfcount+1 if(nfcount.gt.100)nfcount=1 f(nfcount)='Alarm: DCCT Discrepancy' fcircuit(nfcount)=circuitname(ncb(n)) fvalue(nfcount)=i1-i2 ftime(nfcount)=t nfault(ncb(n),2) = 1 ENDIF ENDIF C C select measurement with largest magnitude C IF (abs(i1).GT.abs(i2)) THEN i = i1 ELSE i = i2 ENDIF C C check for branch overcurrent C IF (abs(i).GT.iboc(n,2).AND.nfault(ncb(n),1).NE.1) THEN nfcount=nfcount+1 if(nfcount.gt.100)nfcount=1 f(nfcount)='Fault: Branch Overcurrent (pulse)' fcircuit(nfcount)=circuitname(ncb(n)) fvalue(nfcount)=i ftime(nfcount)=t CALL faultlogic (ncb(n),t) ENDIF C C sum up load current C iload(ncb(n)) = iload(ncb(n))+i 100 CONTINUE C C loop through circuits, set load currents in locked out twin circuits C check for overcurrent/i2t faults C simulate coil temperature and check for overtemperature C calcuate axial forces and compare with limits C calcuate tf joint loads C DO 200, n = 1,NCOILS if(nlock(n).eq.1)then C C circuit is locked out, apply twin load current if twin is active C if(n.eq.IDX_PF1AU.and.nlock(IDX_PF1AL).eq.0)then iload(IDX_PF1AU)=iload(IDX_PF1AL) endif if(n.eq.IDX_PF1AL.and.nlock(IDX_PF1AU).eq.0)then iload(IDX_PF1AL)=iload(IDX_PF1AU) endif if(n.eq.IDX_PF2U.and.nlock(IDX_PF2L).eq.0)then iload(IDX_PF2U)=iload(IDX_PF2L) endif if(n.eq.IDX_PF2L.and.nlock(IDX_PF2U).eq.0)then iload(IDX_PF2L)=iload(IDX_PF2U) endif if(n.eq.IDX_PF3U.and.nlock(IDX_PF3L).eq.0)then iload(IDX_PF3U)=iload(IDX_PF3L) endif if(n.eq.IDX_PF3L.and.nlock(IDX_PF3U).eq.0)then iload(IDX_PF3L)=iload(IDX_PF3U) endif endif C C check for load overcurrent C IF (abs(iload(n)).GT.iloc(n).AND.nfault(n,1).NE.1) THEN nfcount=nfcount+1 if(nfcount.gt.100)nfcount=1 f(nfcount)='Fault: Load Overcurrent' fcircuit(nfcount)=circuitname(n) fvalue(nfcount)=iload(n) ftime(nfcount)=t if(n.gt.NCOILS_V0.or.n.eq.IDX_TF.or.n.eq.IDX_CHI)then C C rwm or tf or chi, fault only that circuit C CALL faultlogic (n,t) else C C pf or oh is faulted, fault OH and all PFs C CALL faultlogic(IDX_OH,t) CALL faultlogic(IDX_PF1AU,t) CALL faultlogic(IDX_PF1AL,t) CALL faultlogic(IDX_PF1B,t) CALL faultlogic(IDX_PF2U,t) CALL faultlogic(IDX_PF2L,t) CALL faultlogic(IDX_PF3U,t) CALL faultlogic(IDX_PF3L,t) CALL faultlogic(IDX_PF5,t) CALL faultlogic(IDX_PF4,t) END IF ENDIF C C update i2t integral C i2t(n) = i2t(n)+iload(n)**2*dt C C check for i2t fault C IF (i2t(n).GT.i2tmax(n).AND.nfault(n,1).NE.1) THEN nfcount=nfcount+1 if(nfcount.gt.100)nfcount=1 f(nfcount)='Fault: I2T Overload' fcircuit(nfcount)=circuitname(n) fvalue(nfcount)=i2t(n) ftime(nfcount)=t CALL faultlogic (n,t) ENDIF C C simulate coil temperature C tcoil(n)=tcoil(n)+ & (iload(n)**2*rcoil(n)- & (tcoil(n)-t0coil(n))/trcoil(n)) & *dt/tccoil(n) C C check for coil overtemperature C IF (tcoil(n).GT.tmcoil(n).AND.nfault(n,1).NE.1) THEN nfcount=nfcount+1 if(nfcount.gt.100)nfcount=1 f(nfcount)='Fault: Thermal Overload' fcircuit(nfcount)=circuitname(n) fvalue(nfcount)=tcoil(n) ftime(nfcount)=t CALL faultlogic (n,t) ENDIF C C update coil resistance C rcoil(n)=r20coil(n)*(1.+coeff*(tcoil(n)-20.)) 200 CONTINUE C C calculate axial forces and tf joint loads C DO 250 n=1,NFV C C nx is circuit number of force variable n C nx=nfvc(n) IF(NLOCK(nx).EQ.1)GO TO 250 fv(n)=0. DO 225 nn=1,NCOILS_V0 IF(NLOCK(nn).NE.1)fv(n)=fv(n)+infmtx(n,nn)*iload(nn) 225 CONTINUE fv(n)=fv(n)*iload(nx)/1e6 C C pf coil axial forces C IF(n.LE.10)THEN fz(nx)=fv(n) C C check for excess axial force C IF(fzmax(nx).GT.0.AND.fz(nx).GT.fzmax(nx) &.OR.fzmax(nx).LT.0.AND.fz(nx).LT.fzmax(nx))THEN IF (nfault(nx,1).NE.1) THEN nfcount=nfcount+1 if(nfcount.gt.100)nfcount=1 f(nfcount)='Fault: Axial Force Overload' fcircuit(nfcount)=circuitname(nx) fvalue(nfcount)=fz(nx) ftime(nfcount)=t if(nx.gt.NCOILS_V0.or.nx.eq.IDX_TF.or.nx.eq.IDX_CHI)then C C rwm or tf or chi, fault only that circuit C CALL faultlogic (nx,t) else C C pf or oh is faulted, fault OH and all PFs C CALL faultlogic(IDX_OH,t) CALL faultlogic(IDX_PF1AU,t) CALL faultlogic(IDX_PF1AL,t) CALL faultlogic(IDX_PF1B,t) CALL faultlogic(IDX_PF2U,t) CALL faultlogic(IDX_PF2L,t) CALL faultlogic(IDX_PF3U,t) CALL faultlogic(IDX_PF3L,t) CALL faultlogic(IDX_PF5,t) CALL faultlogic(IDX_PF4,t) END IF ENDIF END IF END IF 250 CONTINUE if(NLOCK(IDX_TF).EQ.1)GO TO 260 C C calculate tf joint loading C C pressure at tf joint C mtfjip6kg=70653. ftfj=0.289 itf6kg=71166.667 mtfjloip=16667. mtfjlooop=2603. ptfjavg=5122. mtfjip=ftfj*mtfjip6kG*(iload(IDX_TF)/itf6kg)**2 mtfjoop=abs(fv(14)) C C in plane C IF(mtfjip.LT.mtfjloip)THEN C C not lifted off in plane C ptfjip=kip(1)+kip(2)*mtfjip ELSE C C lifted off in plane ptfjip=kip(3)/(kip(4)+kip(5)*mtfjip) END IF C C out of plane C IF(mtfjoop.LT.mtfjlooop)THEN C C not lifted off out of plane C ptfjoop=koop(1)+koop(2)*mtfjoop ELSE C C lifted off out of plane ptfjoop=koop(3)/(koop(4)+koop(5)*mtfjoop) END IF C C combine in plane and out of plane effects C ptfj=ptfjip*ptfjoop/ptfjavg C C check for excess pressure at tf joint C IF (ptfj.GT.ptfjmax.AND.nfault(nx,1).NE.1) THEN nfcount=nfcount+1 if(nfcount.gt.100)nfcount=1 f(nfcount)='Fault: Excess TF Joint Pressure' fcircuit(nfcount)=circuitname(nx) fvalue(nfcount)=ptfj ftime(nfcount)=t CALL faultlogic (nx,t) ENDIF C C flag box friction load calculation C C skip this section if no oop loading C if(mtfjoop.eq.0.)then f1boop=0. go to 259 end if flateral=fv(11) mlateral=fv(12) rlateral=mlateral/flateral mbundle=fv(13) rbundle=3.85 fmbundle=0.82 nturns=36 fbundle=mbundle/rbundle*fmbundle/nturns f3b=(fbundle*kb(1)+flateral*rlateral)*kb(2)/kb(3)- &(fbundle+flateral)*kb(2)/kb(4) f1b=(f3b*kb(5)-(fbundle+flateral)*kb(2))/kb(6) f2b=f1b-(f1b-f3b)*kb(7) f1boop=f1b/2.+(f1b+f2b+f3b)/3. 259 CONTINUE f1bip=kb(8)*iload(IDX_TF)**2 ftfjb=sqrt(f1boop**2+f1bip**2) C C check for box friction overload C IF (ftfjb.GT.ftfjbmax.AND.nfault(nx,1).NE.1) THEN nfcount=nfcount+1 if(nfcount.gt.100)nfcount=1 f(nfcount)='Fault: TF Flag Box Friction Overload' fcircuit(nfcount)=circuitname(nx) fvalue(nfcount)=ftfjb ftime(nfcount)=t CALL faultlogic (nx,t) ENDIF 260 CONTINUE if (nsubmode.eq.1) call pc_seti !Set iload etc for plasmacontrol C C loop through poles C DO 300, n = 1,NPOLES C C determine current flowing into pole C IF (npsum(n,1).NE.0) THEN C C include current from this circuit C iin = iload(npsum(n,1)) C C set current to zero if current direction not allowed C IF (iin*nppole(npsum(n,1)).LT.0.) iin = 0. ELSE C C no current to be included from this circuit C iin = 0. ENDIF C C determine current flowing out of pole C IF (npsum(n,2).NE.0) THEN C C include current from this circuit C iout = iload(npsum(n,2)) C C set current to zero if current direction not allowed C IF (iout*nppole(npsum(n,2)).LT.0.) iin = 0. ELSE C C no current to be included from this circuit C iout = 0. ENDIF ipole = iin-iout C C update pole resistance and temperature C rpole(n) = r20pole(n)*(1.+coeff*(tpole(n)-20.)) tpole(n) = tpole(n)+(ipole**2*rpole(n)-(tpole(n)-t0pole) & /trpole(n))*dt/tcpole(n) C C check for rms overload (excessive pole temperature) C IF (tpole(n).GT.tmpole) THEN IF(npsum(n,1).ne.0)THEN C C skip if alarm already set C IF(nfault(npsum(n,1),2).eq.1)GO TO 270 C C set alarm C nfault(npsum(n,1),2)=1 GO TO 280 ENDIF 270 CONTINUE IF(npsum(n,2).ne.0)THEN C C skip if alarm already set C IF(nfault(npsum(n,2),2).eq.1)GO TO 290 C C set alarm C nfault(npsum(n,2),2)=1 ELSE C C alarm already set for nspum(n,1) and npsum(n,2) = 0 C GO TO 290 ENDIF 280 CONTINUE nfcount=nfcount+1 if(nfcount.gt.100)nfcount=1 f(nfcount)='Alarm: Pole RMS Overload' fcircuit(nfcount)=circuitname(npsum(n,1)) fvalue(nfcount)=tpole(n) ftime(nfcount)=t 290 CONTINUE ENDIF 300 CONTINUE RETURN END ********************************************************************* SUBROUTINE standbycurrent ********************************************************************* C C determine branch currents from measurements C check for dcct discrepancies C check for branch overcurrents C store measurement offsets C simulate coil temperature decay C simulate pole temperature decay C C C alarm in case of pole rms overload C IMPLICIT NONE !Arguments: !--------- !none !Common Blocks: !------------- include 'rtcdef.inc' !Parameters: !---------- integer NBRANCHES_2 !for sumArray initialization integer NBRANCHES_200 !for omeas2 initialization parameter (NBRANCHES_2=NBRANCHES*2) parameter (NBRANCHES_200=NBRANCHES*2*100) !Local Variables: !--------------- integer n,n1,nb real*4 di real*4 i,i1,i2 integer nsumIdx real*4 sumArray(NBRANCHES*2) real*4 omeas2(NBRANCHES*2,100) real*4 xavg !!! volatile nsumIdx,sumArray,omeas2 data nsumIdx/0/,sumArray/NBRANCHES_2*0/,omeas2/NBRANCHES_200*0/ !Format statements: !----------------- 111 format('Fault: Branch Overcurrent (stby), Circuit=',A, % ' Branch=',I2,' I=',f7.3,' kA') 112 format('Alarm: Offset.gt.DIMAX, Branch=',A,' Branch#=',I2, % ' Measurement#=',I3,' Offset=',F7.2) nsumIdx = nsumIdx+1 if (nsumIdx .gt. 100) nsumIdx = 1 C C loop through circuits C DO 100 n=1,NCOILS C C assume load current = 0 C C C simulate coil temperature C tcoil(n) = tcoil(n) - & (tcoil(n)-t0coil(n))/trcoil(n) & *dt/tccoil(n) C C update coil resistance C rcoil(n)=r20coil(n)*(1.+coeff*(tcoil(n)-20.)) 100 CONTINUE C C loop through branches, check for overcurrents C DO 250, n = 1,NBRANCHES C C skip branches with multiplier set to zero C IF (kpb(n).EQ.0) GOTO 250 C C skip locked out circuits C IF (nlock(ncb(n)).EQ.1) GOTO 250 C C compare redundant measurements of branch current C i1 = imeas(nmeas(n,1)) i2 = imeas(nmeas(n,2)) di = abs(i1-i2) IF (di.GT.dimax(n)) THEN IF (nfault(ncb(n),2).NE.1) THEN C C dcct discrepancy C if (dt.ge.1.0) then write(6,*) WRITE(6,*)'Alarm: DCCT Discrepancy, Circuit=', & circuitname(ncb(n)),'Branch#=',n, & 'I1=',i1,'I2=',i2,'Delta=',abs(i1-i2) endif nfault(ncb(n),2) = 1 nfcount=nfcount+1 if (nfcount.gt.100) nfcount = 1 ENDIF ENDIF C C select measurement with largest magnitude C IF (abs(i1).GT.abs(i2)) THEN i = i1 ELSE i = i2 ENDIF C C check for branch overcurrent C IF (abs(i).GT.iboc(n,1).AND.nfault(ncb(n),1).NE.1) THEN write(6,*) write(6,111) circuitname(ncb(n)),n,i/1000. nfault(ncb(n),1)=1 nfaultFlag = 1 !Set flag for outdat() nfcount = nfcount+1 !added 06-Jan-1999, cn/trg if (nfcount.gt.100) nfcount=1 !added 06-Jan-1999, cn/trg ENDIF C C compute simple moving average of offsets based on 100 samples C C C perform calcs for the two sets of NBRANCHES branches C do 225 n1=1,2 nb=n+(n1-1)*NBRANCHES sumArray(nb) = sumArray(nb) - omeas2(nb,nsumIdx) !new omeas2(nb,nsumIdx) = imeas(nmeas(n,n1)) sumArray(nb) = sumArray(nb) + omeas2(nb,nsumIdx) xavg = sumArray(nb)/100. aomeas(n,n1) = xavg C C check if offset in allowed range C IF (aomeas(n,n1).GT.dimax(n).AND. > nfault(ncb(n),1).NE.1) THEN if (dt.ge.1.0) then write(6,112) circuitname(ncb(n)),n,n1,aomeas(n,n1) endif nfault(ncb(n),2)=1 nfcount=nfcount+1 if(nfcount.gt.100) nfcount=1 ENDIF 225 continue 250 CONTINUE !Even though we haven't really calculated ! iload (it's been set to 0), write it ! to the pcs communication buffer ... if (nsubmode.eq.1) call pc_seti !----------------------------------- C C loop through poles C DO 300, n = 1,NPOLES C C assume pole current equal to zero between pulses C C C update pole resistance and temperature C rpole(n) = r20pole(n)*(1.+coeff*(tpole(n)-20.)) tpole(n) = tpole(n) - & (tpole(n)-t0pole)/trpole(n) & *dt /tcpole(n) 300 CONTINUE RETURN END ********************************************************************* SUBROUTINE faultcheck(t) ********************************************************************* C C check oh/pf1b launching load constraint C check tf on if chi on C IMPLICIT NONE !Arguments: !--------- REAL*4 t !Common Blocks: !------------- include 'rtcdef.inc' !Local Variables: !--------------- !none !!! call tfforecaster(t) !!! !Note: tfforecaster is being called BEFORE the new !!! ! value for v2 is calculated (in pscontrol). Seems !!! ! to give good results though, perhaps because of !!! ! delays in system response ... !!! !Perhaps should try calling tfforecaster AFTER pscontrol !!! ! has been called, just to see how close tfestimate comes !!! ! to reality. IF(nlock(IDX_PF1B).EQ.1.OR.nfault(IDX_PF1B,1).EQ.1)THEN C C pf1b is locked out or faulted; skip this check C GOTO 100 ELSE IF (iload(IDX_OH)*iload(IDX_PF1B).LT.alaunch) THEN C C launching load fault, set fault flag for PF1b C nfcount=nfcount+1 if(nfcount.gt.100)nfcount=1 f(nfcount)='Fault: Launching Load' fcircuit(nfcount)='OH/PF1B' fvalue(nfcount)=iload(IDX_OH)*iload(IDX_PF1B) ftime(nfcount)=t CALL faultlogic(IDX_PF1B,t) ENDIF ENDIF 100 CONTINUE RETURN END !!!********************************************************************* !!! SUBROUTINE chiarc_init !!!********************************************************************* !!! include 'chiarc.inc' !!! !!! integer i !!! !!! chiArcTime = -999.0 !!! tfBkgdSum = 0.0 !!! tfIntegralSum = 0.0 !!! do i=1,NCHI_BUFSIZE !!! tfbuf(i) = 0.0 !!! enddo !!! do i=1,NCHI_INTEGRATE !!! integrateBuf(i) = 0.0 !!! enddo !!! nchi = 1 !!! kchi = 1 !!! chiArcFlag = .FALSE. !!! !!! !Initialize tfforecaster also ... !!! do i=1,NINT_BUFSIZE !!! tferrBuf(i) = 0.0 !!! enddo !!! do i=1,NBASE_BUFSIZE !!! baseBuf(i) = 0.0 !!! enddo !!! do i=1,NDI_BUFSIZE !!! dibuf(i) = 0.0 !!! enddo !!! do i=1,NERRBASE_BUFSIZE !!! errBaseBuf(i) = 0.0 !!! enddo !!! nidxErr = 1 !!! nidxErrBase = 1 !!! nidxBase = 1 !!! nidxDi = 1 !!! tferrAcc = 0.0 !!! errBaseAcc = 0.0 !!! baseAcc = 0.0 !!! diAcc = 0.0 !!! diAdjust = 0.0 !!! tfestimate = 0.0 !!! newChiArcFlag = .FALSE. !!! !!! return !!! end !!! !!! !!! !!!********************************************************************* !!! SUBROUTINE chiarcdetector(t) !!!********************************************************************* !!!C !!!C compute effective chi impedance !!!C declare fault if impedance below minimum allowable zchimin !!!C for more than nchidelay samples !!!C !!!!!! DIMENSION iload(NCOILS) !!!!!! DIMENSION nlock(NCOILS),napon(NCOILS),a1(NCOILS) !!!!!! DIMENSION tfault(NCOILS),tbdelay(NCOILS),nfault(NCOILS,2) !!! IMPLICIT none !!! !!!!Arguments: !!! REAL*4 t ! time within shot !!! !!!!Include files: !!! include 'rtcdef.inc' !!! include 'chiarc.inc' !!! !!!!Functions: !!! !!!!Parameters: !!! INTEGER VCHI_DAS_CHANNEL !!! parameter (VCHI_DAS_CHANNEL=59) !!! !!!!Local variables: !!! integer k2 !!! REAL*4 ichi !!! REAL*4 vchi !!! REAL*4 zchi !!! LOGICAL arcFlagTF !TRUE if CHI arc detected via TF !!! !!!!Executable code: !!! vchi = imeas(VCHI_DAS_CHANNEL) !!! !!!C !!!C skip if CHI is locked out !!!C !!! if(nlock(10).eq.1) return !!! !!! !Check for fluctuations in TF level, indicating !!! ! an arc in CHI ... !!! !------------------------------------------------- !!! !--- Step 1: update TF "bkgd" level ... !!! tfBkgdSum = tfBkgdSum - tfbuf(kchi) !!! tfbuf(kchi) = iload(IDX_TF) !save latest TF !!! k2 = kchi - NCHI_INTEGRATE !idx of next tfbuf in bkgd !!! if (k2 .LT. 1) k2 = k2+NCHI_BUFSIZE !..keep idx reasonable !!! tfBkgdSum = tfBkgdSum + tfbuf(k2) !include in new bkgd val !!! kchi = kchi+1 !next avail idx in tfbuf !!! if (kchi .GT. NCHI_BUFSIZE) kchi=1 !..keep idx reasonable !!! !!! !--- Step 2: Update TF Integral ... !!! tfIntegralSum = tfIntegralSum - integrateBuf(nchi) !!! integrateBuf(nchi) = iload(IDX_TF) - tfBkgdSum/NCHI_BKGD !!! tfIntegralSum = tfIntegralSum + integrateBuf(nchi) !!! nchi = nchi+1 !next avail integrateBuf() !!! if (nchi .GT. NCHI_INTEGRATE) nchi=1 !..keep idx reasonable !!! !!! !--- Step 3: Check for possible CHI fault ... !!! if (abs(tfIntegralSum) .GE. CHI_ARC_INTEGRAL_SUM) then !!! chiArcTime = t !!! chiArcFlag = .TRUE. !!! endif !!! !!! arcFlagTF = newChiArcFlag !!!C !!!C determine chi current magnitude !!!C !!! ichi=abs(iload(10)) !!!C !!!C skip check if current below ichi0 !!!C !!! if(ichi.lt.ichi0) return !!!C !!!C calculate chi impedance magnitude !!!C !!! if(ichi.gt.0)then !!! zchi=abs(vchi)/ichi !!! else !!! zchi=1.e6 !!! end if !!!C !!!C check if impedance too low (arcing) !!!C !!! IF (zchi.lt.zchimin) THEN !!!C !!!C arcing, increment nchiarc !!!C !!! nchiarc=nchiarc+1 !!! ENDIF !!!C !!!C fault chi if delay has expired or if arcFlagTF set !!!C !!! IF (nchiarc.gt.nchidelay .or. arcFlagTF) THEN !!! nchiblock = 1 !Set nchiblock flag !!! IF (nfault(10,1).EQ.0)THEN !!! nfcount=nfcount+1 !!! if(nfcount.gt.100)nfcount=1 !!! if (nchiarc.gt.nchidelay) then !!! f(nfcount)='Fault: CHI arcing (zchi low)' !!! fvalue(nfcount)=zchi !!! else !!! f(nfcount)='Fault: CHI arcing (tf-based detection)' !!! fvalue(nfcount)=integDiff/float(NINT_BUFSIZE) !!! endif !!! fcircuit(nfcount)='CHI' !!! ftime(nfcount)=t !!! IF (nfault(10,1).NE.1) CALL faultlogic(10,t) !!! ENDIF !!! ELSE !!!C !!!C not arcing, reset nchiarc !!!C !!! nchiarc=0 !!! ENDIF !!! return !!! end !!! !!! !!! !!!********************************************************************* !!! SUBROUTINE tfforecaster(t) !!!********************************************************************* !!!C Estimate next TF, record tfEstimate errors ... !!! IMPLICIT none !!! !!!!Arguments: !!! REAL*4 t ! time within shot !!! !!!!Include files: !!! include 'rtcdef.inc' !!! include 'chiarc.inc' !!! !!!!Local variables: !!! real*4 ditf !tf current change calculated !!! real*4 rtfloop !total resistance in TF loop !!! real*4 vtf !tf voltage for next step !!! !!!!Executable: !!!C !!!C record error from previous estimated TF !!!C !!! tferrAcc = tferrAcc - tferrBuf(nidxErr) !!! tferrBuf(nidxErr) = tfestimate - iload(IDX_TF) !!! tferrAcc = tferrAcc + tferrBuf(nidxErr) !!! nidxErr = nidxErr+1 !!! if (nidxErr .GT. NINT_BUFSIZE) nidxErr=1 !!! !!! !======================================= !!! !Calculate errBase level ... !!! !This is the baseline for tferr !!! errBaseAcc = errBaseAcc - errBaseBuf(nidxErrBase) !!! errBaseBuf(nidxErrBase) = tferrAcc !!! errBaseAcc = errBaseAcc + errBaseBuf(nidxErrBase) !!! nidxErrBase = nidxErrBase+1 !!! if (nidxErrBase .GT. NERRBASE_BUFSIZE) nidxErrBase = 1 !!! !!! !======================================= !!! !Check for fault ... !!! !======================================= !!! integDiff = tferrAcc - errBaseAcc/float(NERRBASE_BUFSIZE) !!! if (.NOT.newChiArcFlag .AND. !!! & iload(IDX_CHI).GE.CHI_MINCURRENT .AND. !!! & integDiff.GT.ARC_LEVEL) then !!! newChiArcFlag = .TRUE. !!! newChiArcTime = t !!! endif !!!C !!!C predict tf current change during next time step. We assume !!!C that "dt" will be roughly constant. !!!C !!! vtf = v2(IDX_TF)*vmax(IDX_TF) !tf voltage for next step !!! rtfloop = rps(IDX_TF) + ecr(IDX_TF) + rcoil(IDX_TF) !total R !!! ditf = (vtf - iload(IDX_TF)*rtfloop)*dt/mc(IDX_TF,IDX_TF) !!! !!! !======================================= !!! !Calculate base level ... !!! !======================================= !!! baseAcc = baseAcc-baseBuf(nidxBase) !!! baseBuf(nidxBase) = iload(IDX_TF) !!! baseAcc = baseAcc+baseBuf(nidxBase) !!! nidxBase = nidxBase+1 !!! if (nidxBase .GT. NBASE_BUFSIZE) nidxBase = 1 !!! !!! !======================================= !!! !Calculate diAdjust, adjustment to base !!! ! level due to requested "ditf"s !!! !======================================= !!! diAdjust = diAdjust + float(NDI_BUFSIZE)*ditf - diAcc !!! diAcc = diAcc - dibuf(nidxDi) !!! dibuf(nidxDi) = ditf !!! diAcc = diAcc + dibuf(nidxDi) !!! nidxDi = nidxDi+1 !!! if (nidxDi .gt. NDI_BUFSIZE) nidxDi = 1 !!! !!! tfestimate = baseAcc/float(NBASE_BUFSIZE) + !!! & diAdjust/float(NDI_BUFSIZE) !!! if (tfestimate .LT. 0.0) tfestimate = 0.0 !!! if (nsubmode .EQ. 0) then !store for inclusion in d.o !!! vsim(IDX_TF-3) = !!! & errBaseAcc/float(NERRBASE_BUFSIZE*NINT_BUFSIZE) !!! vsim(IDX_TF-2) = tferrAcc/float(NINT_BUFSIZE) !!! vsim(IDX_TF-1) = integDiff/float(NINT_BUFSIZE) !!! vsim(IDX_TF) = tfestimate !!! vsim(IDX_TF+1) = ditf !!! endif !!! !!! return !!! end ********************************************************************* SUBROUTINE pscontrol(t) ********************************************************************* C C power supply control function C IMPLICIT NONE !Arguments: !--------- REAL*4 t !Common Blocks: !------------- include 'rtcdef.inc' include 'nstx_savedata.inc' !Local Variables: !--------------- integer n real*4 clierr real*4 psmode real*4 target real*4 ff,rtot,tau,v0max !for v0max calculation real*4 ienb !Integral-Enable fraction real*4 G !Adjustment to iloc in v0max calculation real*4 tmp real*4 SPA_MAX_VREF !max reference (ctrl) voltage to SPA parameter (ienb=0.025 , G=0.98) DO 1000, n = 1,NCOILS IF (nlock(n).EQ.1) THEN C C skip locked out circuits C GOTO 1000 ENDIF C C set controls for faulted circuits C IF (nfault(n,1).EQ.1) THEN C C delay bypassing if circuit is antiparallel and still active C IF (nap(n).EQ.1.AND.nbb(n).eq.1) THEN !14-Oct-99 TRG change napon to nap C C check if delay time still not elapased C IF (t-tfault(n).LT.tbdelay(n))THEN C C delay still underway, hold at alpha = 90 degrees C a1(n)=astdby(n) a2(n)=astdby(n) ELSE C C delay completed, suppress and bypass C ncvt1(n) = 0 ncvt2(n) = 0 nbb(n) = 0 ENDIF ELSE C C circuit is not antiparallel, suppress and bypass C ncvt1(n) = 0 ncvt2(n) = 0 nbb(n) = 0 ENDIF GOTO 1000 ENDIF C C circuit is not locked out and not faulted, therefore ok to block bypass C nbb(n)=1 nclamp(n) = 0 C C if plasma control enabled and functioning, target is from pcs. C if enabled but not ok, revert to shutdown idot C IF (npc(n).EQ.1 .and. t.ge.tpcstart) THEN if (npcon .eq. 1) then !plasmacontrol is ok ? psmode = 1 !..voltage control target = vprtc(n) !..target from plasmacontrol else !else, problem with plasmacontrol psmode = 0 !..current control IF (iref(n).GT.0.) THEN target = iref(n)-disd(n) IF (target.LT.0.) target = 0 ELSE IF (iref(n).LT.0.) THEN target = iref(n)+disd(n) IF (target.GT.0.) target = 0 ELSE target = 0 ENDIF endif ELSE !Else, target is "reference" waveform C C determine if time has past former "future" breakpoint IF (t.GT.dat(n,ndat(n)+1,1)) THEN C C increment breakpoint counter C ndat(n) = ndat(n)+1 ENDIF C C determine psmode and reference data C C set psmode to that of "past" breakpoint C psmode = dat(n,ndat(n),3) C C linear interpolation of reference data C target = dat(n,ndat(n),2) & +(dat(n,ndat(n)+1,2)-dat(n,ndat(n),2)) & /(dat(n,ndat(n)+1,1)-dat(n,ndat(n),1))*(t-dat(n,ndat(n),1)) ENDIF C C psmode = 0 for current control, 1 for voltage control C IF (psmode.EQ.0) then C C current control C iref(n) = target ierr(n) = iref(n)-iload(n) if (target.ne.0.0 .and. abs(ierr(n)/target).le.ienb) then intierr(n) = intierr(n) + ierr(n)*dt else intierr(n) = 0 endif v0(n) = ierr(n)*gain(n,1,1)+intierr(n)*gain(n,2,1) ELSE C C voltage control C iref(n) = 0. vref(n)=target vcomm(n) = target*nplink(n) !Calculate v0max for this circuit. !..set v0(n) accordingly ... rtot = rps(n) + ecr(n) + rcoil(n) !Total resistance now tau = mc(n,n)/rtot if (n .LE. NCOILS_V0) then !Original TransRex coil set ff = exp(-dt/tau) ! e^^(-dt/tau) v0max = rtot * (G*sign(iloc(n),iload(n)) - ff*iload(n)) / > (1.0 - ff) if (abs(vcomm(n)) .LE. abs(v0max)) then v0(n) = vcomm(n) else !Maybe apply limit ... if (vcomm(n)*v0max .GT. 0.0) then v0(n) = v0max !..vcomm & v0max are same sign nclamp(n) = 2 !use 2 for v0max clamp nclampm = ibset(nclampm,(n-1)) else v0(n) = vcomm(n) !..different signs: accept vcomm endif endif else !else, RWM/SPA ... C C temporary fudge to allow local SPA CLCC C with v representing i up to 3333.33 amp C C v0max = vp13spa v0max = 3333.33 if (abs(vcomm(n)) .LE. abs(v0max)) then v0(n) = vcomm(n) else v0(n) = sign(v0max,vcomm(n)) endif endif C C clamp current if required C IF (iload(n).GT.iclp(n).OR.iload(n).LT.icln(n)) THEN C C outside of allowed range, impose clamping C nclamp(n) = 1 !use 1 for icln-to-iclp clamp nclampm = ibset(nclampm,(n-1)) IF (iload(n).GT.0.) THEN clierr = iclp(n)-iload(n) ELSE clierr = icln(n)-iload(n) ENDIF intclierr(n) = intclierr(n)+clierr*dt vclamp(n) = clierr*gain(n,1,2)+intclierr(n)*gain(n,2,2) v0(n) = v0(n)+vclamp(n) ELSE intclierr(n) = 0. ENDIF ENDIF C C determine if antiparallel mode is in effect C IF (nap(n).EQ.0) GOTO 700 C C antiparallel is enabled C IF (abs(iload(n)).GT.ithresh(n)) THEN C C outside zero current region, reset napon status C napon(n) = 0 C C reset flag preventing initial antiparallel mode, now that C threshold has been crossed C napblock(n) = 0 ENDIF IF (abs(iload(n)).LT.ithresh(n).AND.napon(n).EQ.0) THEN C C just entered region around current zero, set napon status C but only if allowed during initial occurrance C IF (napblock(n).EQ.0) napon(n) = 1 ENDIF 700 CONTINUE C C process voltage request C C C per-unitize voltage request C v1(n) = v0(n)/vmax(n) C C apply clamp if required C IF (abs(v1(n)).GT.1.) THEN IF (v1(n).GT.0.) THEN v1(n) = 1. ELSE v1(n) = -1. ENDIF ENDIF C C apply rate limit C C check new v1 request vs. old v2 C tmp = abs(v1(n)-v2(n)) / dvmax(n) if (tmp .GT. 5.00) nsaveFlag = 10 !save high-speed data if (tmp .GT. 1.0) THEN !dv .GT. dvmax? C C need to apply rate limit C IF (v1(n).GT.v2(n)) THEN v2(n) = v2(n)+dvmax(n) ELSE v2(n) = v2(n)-dvmax(n) ENDIF ELSE C C no rate limit required, set v2 to v1 request C v2(n) = v1(n) ENDIF if (n .LE. NCOILS_V0) then !original set of TransRex coils C C determine alpha max C amax(n) = acos(amaxmult(n)*abs(iload(n))-cosgamma(n)) IF (napon(n).EQ.0) THEN amin(n) = 0. ELSE amin(n) = pi-amax(n) ENDIF C C determine requested firing angle: C a0(n) = acos(v2(n)) C C set power supply commands C IF (nap(n).EQ.1) THEN C C antiparallel bipolar circuit C IF (napon(n).EQ.1) THEN C C antiparallel active, both converter groups active C ncvt1(n) = 1 ncvt2(n) = 1 if(a0(n).gt.amax(n))a0(n)=amax(n) if(a0(n).lt.amin(n))a0(n)=amin(n) a1(n)=a0(n) a2(n)=pi-a1(n) ELSE C C antiparallel inactive, only one converter group active C IF (iload(n)*nplink(n).GE.0.) THEN C C positive converter group active C ncvt1(n) = 1 ncvt2(n) = 0 a1(n)=a0(n) if(a1(n).gt.amax(n))a1(n)=amax(n) a2(n)=pi-a1(n) if(a2(n).gt.amax(n))a2(n)=amax(n) ELSE C C negative converter group active C ncvt1(n) = 0 ncvt2(n) = 1 a2(n)=pi-a0(n) if(a2(n).gt.amax(n))a2(n)=amax(n) a1(n)=pi-a2(n) if(a1(n).gt.amax(n))a1(n)=amax(n) ENDIF ENDIF !end (napon(n).EQ.1) ELSE C C unipolar circuit C ncvt1(n) = 1 a1(n)=a0(n) if(a1(n).gt.amax(n))a1(n)=amax(n) ENDIF ELSE !else these are RWM/SPA coils ... if(t.ge.tireset(n))then ncvt1(n) = 1 else ncvt1(n)=0 end if a1(n) = v2(n) * SPA_MAX_VREF ENDIF !end (n .LE. NCOILS_V0) 1000 CONTINUE if(nlockp13.eq.0)then C C p13 active, set up p13 commands stored in IDX_RWM1 set 2 locations C a2(IDX_RWM1)=ap13 ncvt2(IDX_RWM1)=1 nbb(IDX_RWM1)=1 end if RETURN END ********************************************************************* SUBROUTINE faultlogic(n,t) C tfault,tbdelay,nfault ! ----- Outputs ********************************************************************* C C fault response function C IMPLICIT NONE !Arguments: !--------- integer n real*4 t !Include: !------- include 'rtcdef.inc' !Local Variables: !--------------- integer n1 real*4 alpha nfaultFlag = 1 !Set flag for outdat() nfault(n,1) = 1 IF (n.EQ.2.OR.n.EQ.3) THEN C C fault PF1aU and PF1aL together C nfault(IDX_PF1AU,1) = 1 nfault(IDX_PF1AL,1) = 1 ENDIF IF (n.EQ.IDX_PF2U.OR.n.EQ.IDX_PF2L) THEN C C fault PF2U and PF2L together C nfault(IDX_PF2U,1) = 1 nfault(IDX_PF2L,1) = 1 ENDIF IF (n.EQ.IDX_PF3U.OR.n.EQ.IDX_PF3L) THEN C C fault PF3U and PF3L together C nfault(IDX_PF3U,1) = 1 nfault(IDX_PF3L,1) = 1 ENDIF IF (n.EQ.IDX_RWM1.OR.n.EQ.IDX_RWM2.OR.n.EQ.IDX_RWM3)THEN C C fault all RWMs together C nfault(IDX_RWM1,1) = 1 nfault(IDX_RWM2,1) = 1 nfault(IDX_RWM3,1) = 1 ENDIF DO 100 n1=1,NCOILS IF(nfault(n1,1).eq.1.and.tfault(n1).eq.0.) THEN C C first time for fault for this circuit C time tag the fault and calculate delay to bypass if antiparallel C tfault(n1)=t IF (nap(n1).EQ.1) THEN !15-Jul-99 TRG change napon to nap C C if antiparallel mode, delay bypassing until ac voltage angle C reaches 15 or 75 degrees C alpha = min(a1(n1),a2(n1))*180./pi tbdelay(n1) = (75.-alpha)/360./fac ENDIF ENDIF 100 CONTINUE RETURN END ********************************************************************* SUBROUTINE save_rtc_data(t) ********************************************************************* IMPLICIT NONE C Arguments: real*4 t C Include COMMON block: include 'rtcdef.inc' include 'nstx_savedata.inc' REAL*4 collectreal(NSAVE_REAL) INTEGER collectint(NSAVE_INT) !extra NCOILS for 2nd dim of nfault(NCOILS,2) EQUIVALENCE (collectreal(1),a0(1)) EQUIVALENCE (collectint(1),napblock(1)) C Local variables: integer n,nn C C Check whether we want to save this dataset ... C .. if not, just return C if (nstep .EQ. 0) then tsaveNext = t endif if (t .GE. tsaveNext) then if (nsaveFlag .EQ. 0) nsaveFlag = 1 tsaveNext = (nint(t*1.e3)+1) * 1.e-3 - 1.e-6 endif if (nsaveFlag .LE. 0) return !not saving data this time C C save collected data C if (nstep .lt. NMAX_DATAPTS) then !avoid overflow of "save" array nstep=nstep+1 nsave=1 save(nsave,nstep)=t DO n=1,NMAX_VARIABLES nn = nselectreal(n) if (nn .eq. 0) goto 900 !done nsave=nsave+1 save(nsave,nstep)=collectreal(nn) ENDDO 900 CONTINUE DO n=1,NMAX_VARIABLES nn = nselectint(n) if (nn .eq. 0) goto 910 !done nsave=nsave+1 save(nsave,nstep)=collectint(nn) ENDDO 910 CONTINUE if (nsave .gt. NMAX_VARIABLES+1) then write(6,*) '*ERROR* main: nsave =',nsave,' *EXIT*' call pscExit(0,'*ERROR* main: nsave too large') endif endif nsaveFlag = nsaveFlag - 1 return end ********************************************************************* SUBROUTINE write_rtc_data ********************************************************************* IMPLICIT NONE !Arguments: !--------- !none !Common Blocks: !------------- include 'rtcdef.inc' include 'nstx_savedata.inc' !Functions and externals: !----------------------- integer nonblanklen !Length of trimmed string !Local Variables: !--------------- integer n,n1 CHARACTER*80 cmdString CHARACTER*24 filename C Format statements C ----------------- 111 format(/'>>>>>>>>>>>>>>>>>> Shot #',I7,' >>>>> filename: ',A/) 990 format(2I8,' realData:',A) 991 format(2I8,' simulation:',A) 992 format(1p6e12.4) 994 format(i3,2x,a36,a6,1pG10.3,0pF7.3) 996 format(A,I8) 999 format(A) if (nstep.eq.0) then return !nothing to save endif C !Set filename for output: if (testMode) then !..Test mode: use date+time call make_test_filename(filename) else !..else, use shot number write(filename,113) nshot 113 format('d_',I6.6,'.o') endif write(6,111) nshot,filename open(20,FILE=filename,STATUS='unknown') if (nsubmode.eq.0) then write(20,990) nsave,nstep, > inputDir(1:nonblanklen(inputDir)) else write(20,991) nsave,nstep, > inputDir(1:nonblanklen(inputDir)) endif do 950 n=1,nstep write(20,992) (save(n1,n),n1=1,nsave) 950 continue write(20,999)'End of data' if(nfcount.ne.0)then C C write fault log to screen and file C write(20,996) 'Faults:',nfcount do 980 n=1,nfcount write(6,994)n,f(n),fcircuit(n),fvalue(n),ftime(n) write(20,994)n,f(n),fcircuit(n),fvalue(n),ftime(n) 980 continue write(20,999)'End of faults' write(6,*) endif close(20) write(cmdString,988) filename 988 format('cat d.o.trailer >> ',A) call system(cmdString) write(6,*) write(6,*) 'Closed output file ',filename return end ********************************************************************* SUBROUTINE shot_summary ********************************************************************* IMPLICIT NONE include 'rtcdef.inc' !!! include 'chiarc.inc' !Local variables integer n C Call any end-of-shot summary routines, etc. !!!101 format(/'--> *TEMP* rtc.f detected CHI Arc at',F7.3,' sec') 103 format(/'nfcount =',I3, & /T6,'Description',T42,'Circ',T48,' Value',T58,' Time') 104 format(i3,2x,a36,a6,1pG10.3,0pF7.3) 105 format(/'--> *TEMP* rtc.f *new* arcDetector: ARC at',F7.3,' sec') call plasmacontrol_summary call profile_display(1) call compare_baselines !!! if (chiArcFlag) then !!! write(6,101) chiArcTime !!! endif !!! if (newChiArcFlag) then !!! write(6,105) newChiArcTime !!! endif if (nfcount .gt. 0) then write(6,103) nfcount do n=1,nfcount write(6,104) n,f(n),fcircuit(n),fvalue(n),ftime(n) enddo endif return end ********************************************************************* SUBROUTINE rtc(t) ********************************************************************* IMPLICIT NONE C Arguments: real*4 t C Include COMMON block: include 'rtcdef.inc' include 'pcs_common.inc' C Local variables: integer n,npcstatus C C check hcs fault status C IF(nlock(IDX_TF).ne.1)THEN IF (nfault(IDX_TF,1).eq.0.and.nhcstf.EQ.1) THEN nfcount=nfcount+1 if(nfcount.gt.100)nfcount=1 f(nfcount)='Fault: External HCS' fcircuit(nfcount)='TF' fvalue(nfcount)=0.0 ftime(nfcount)=t write(6,*) 'The TF HCS system has a fault.' CALL faultlogic(IDX_TF,t) ENDIF ENDIF IF(nlock(IDX_OH).ne.1)THEN IF (nfault(IDX_OH,1).eq.0.and.nhcsoh.EQ.1) THEN nfcount=nfcount+1 if(nfcount.gt.100)nfcount=1 f(nfcount)='Fault: External HCS' fcircuit(nfcount)='OH' fvalue(nfcount)=0.0 ftime(nfcount)=t write(6,*) 'The OH HCS system has a fault.' CALL faultlogic(IDX_OH,t) ENDIF ENDIF IF (nfault(IDX_PF1AU,1).eq.0.and.nhcspfchi.EQ.1) THEN IF(nlock(IDX_PF1AU).ne.1.or. & nlock(IDX_PF1AL).ne.1.or. & nlock(IDX_PF1B).ne.1.or. & nlock(IDX_PF2U).ne.1.or. & nlock(IDX_PF2L).ne.1.or. & nlock(IDX_PF3U).ne.1.or. & nlock(IDX_PF3L).ne.1.or. & nlock(IDX_PF5).ne.1.or. & nlock(IDX_PF4).ne.1) & THEN nfcount=nfcount+1 if(nfcount.gt.100)nfcount=1 f(nfcount)='Fault: External HCS' fcircuit(nfcount)='PF' fvalue(nfcount)=0.0 ftime(nfcount)=t write(6,*) 'The PF HCS system has a fault.' CALL faultlogic(IDX_PF1AU,t) CALL faultlogic(IDX_PF1AL,t) CALL faultlogic(IDX_PF1B,t) CALL faultlogic(IDX_PF2U,t) CALL faultlogic(IDX_PF2L,t) CALL faultlogic(IDX_PF3U,t) CALL faultlogic(IDX_PF3L,t) CALL faultlogic(IDX_PF5,t) CALL faultlogic(IDX_PF4,t) CALL faultlogic(IDX_RWM1,t) CALL faultlogic(IDX_RWM2,t) CALL faultlogic(IDX_RWM3,t) ENDIF ENDIF IF (nfault(IDX_RWM1,1).eq.0.and.nhcsspa.EQ.1) THEN IF(nlock(IDX_RWM1).ne.1.or. & nlock(IDX_RWM2).ne.1.or. & nlock(IDX_RWM3).ne.1) & THEN nfcount=nfcount+1 if(nfcount.gt.100)nfcount=1 f(nfcount)='Fault: External HCS' fcircuit(nfcount)='RWM' fvalue(nfcount)=0.0 ftime(nfcount)=t write(6,*) 'The RWM HCS system has a fault.' CALL faultlogic(IDX_RWM1,t) CALL faultlogic(IDX_RWM2,t) CALL faultlogic(IDX_RWM3,t) ENDIF ENDIF call profile_update(10,'rtc: before pulsecurrent') CALL pulsecurrent(t) call profile_update(20,'rtc: before faultcheck') CALL faultcheck(t) IF(npcon.eq.1) THEN C C exchange data with plasma control C call profile_update(30,'rtc: before plasmacontrol') CALL plasmacontrol(npcstatus) C C if plasma control is not ready, revert to fault C IF (npcready.EQ.0) THEN nfcount=nfcount+1 if(nfcount.gt.100)nfcount=1 f(nfcount)='Fault: Plasma Control Not Ready' fcircuit(nfcount)='Plasma Control' fvalue(nfcount)=0.0 ftime(nfcount)=t npcon = 0 DO 300, n = 1,NCOILS CALL faultlogic(n,t) 300 CONTINUE ENDIF C C if plasma control has turned off, revert to shutdown C IF (npcstatus.EQ.0.OR.t.GT.tpcend) THEN IF (t.GT.tpcstart) THEN write(6,101) t,tpcstart,tpcend 101 format('Turn npcon OFF: t=',F7.3,' tpcstart=',F7.3, & ' tpcend=',F7.3) npcon = 0 DO 350, n = 1,NCOILS IF(npc(n).eq.1)iref(n) = iload(n) 350 CONTINUE ENDIF ENDIF ELSE IF (npcsTest) THEN CALL plasmacontrol(npcstatus) ENDIF call profile_update(40,'rtc: before pscontrol') CALL pscontrol(t) C C pscontrol returns ncvt1,ncvt2,a1,a2, & nbb call profile_update(48,'rtc: *end*') return end