! 7-Feb-2019; Ver 1.3 ! - Allowed four digits for sample loop flow meter output, as when it reads faulty, it can be > 2000 mL/min ! and this causes problems ! 28-Oct-2018; Ver 1.2 ! - Added some extra redundant reading of DO and pH probes. ! - Fixed bug on reading MC2 pH and DO ! 27-Oct-2018 ! - Slight modifications. ! - Added N2 to the sample loop purge, but only when monitoring gasses, such as during calibration, it is not part of the ! sampling sequence ! - Update sample loop volume after modifying the Oxigraf analyzer. Use 20 mL, but it's probably smaller than that. ! 4-Oct-2018 ! - Ver 1.0: First version of the MCP (DEB project with Julie and Ashley) chemostat monitor ! This is a major revision of V1.21 used in the MonitorA2M project Module CommParameters ! This module contains all the global parameters use ifqwin !use ifwin ! Note, there is a conflict with the routine SLEEP with ifport module use ifwin, only: T_CONSOLE_SCREEN_BUFFER_INFO, T_COORD, T_SMALL_RECT, GETSTDHANDLE, GETCONSOLESCREENBUFFERINFO, & STD_OUTPUT_HANDLE, HANDLE, SETCONSOLECURSORPOSITION use ifWINTY use ifcore use ifport Implicit none !============= Define Which ports go to which equip ================= integer, parameter:: WTAINport = 3 ! Weeder Tech WTAIN board. Measure output from pH and DO probes ! A: pH algae ! B: DO algae ! C: pH digestor ! D: pH digestor integer, parameter:: oxigrafPort = 4 ! Serial connection to Oxigraf for CO2 and O2 !integer, parameter:: ch4Port = 5 ! CAI NDIR methane analyzer integer, parameter:: valcoPort = 6 ! Valco 10 port multiselector integer, parameter:: mfmPort = 7 ! MKS digial mass flow meter readout of sample loop gas flow integer, parameter:: mfcPort = 8 ! MKS 647C controller (also used by MonitorMFC program). integer, parameter:: WTDOTport = 9 ! Controls ASCO Red Hat valves and sample loop gas pump. ! Currently, the following channels are used: ! A: N2 gas for nafion dryer ! B: Sample loop pump ! C: N2/CH4 mix for CH4 offset ! D: N2 sample loop purge ! E: Air SL purge and CO2 and O2 offsets ! F-H: Not used integer, parameter:: WTDACport = WTDOTport ! Used to send 0-10V signal to cole-parmer pump. It is plugged into the WTDOT board ! A: is the voltage input to the cole-parmer pump on pins 1 (pos) and 3 (gnd) on the DB-25 connector ! This is daisy changed to WTDOTport 9 above integer, parameter:: WTAIN2port = WTDOTport ! Weeder Tech WTAIN board 2, plugged into WTDAC board ! A: Connected to voltage output on cole-parmer pump on pins 14 (pos) and 5 (gnd). Note, found that ! grounds 3 and 5 must be connected together to avoid ground loop problems with the WTAIN board reading. ! This is daisy changed to WTDOTport 9 above through WTDACport ! so uses the same serial port. It is set to address B. !===================CHARACTER CONSTANTS=================================== CHARACTER(LEN=1), PARAMETER :: SOH = CHAR( 1) CHARACTER(LEN=1), PARAMETER :: STX = CHAR( 2) CHARACTER(LEN=1), PARAMETER :: ETX = CHAR( 3) CHARACTER(LEN=1), PARAMETER :: EOT = CHAR( 4) CHARACTER(LEN=1), PARAMETER :: ENQ = CHAR( 5) CHARACTER(LEN=1), PARAMETER :: ACK = CHAR( 6) CHARACTER(LEN=1), PARAMETER :: NAK = CHAR(15) CHARACTER(LEN=1), PARAMETER :: DLE = CHAR(16) CHARACTER(LEN=1), PARAMETER :: ESC = CHAR(27) CHARACTER(LEN=1), PARAMETER :: CR = CHAR(13) CHARACTER(LEN=2), PARAMETER :: crlf = CHAR(13)//CHAR(10) ! Some WeederTech WTDOT commands. These are based on which channel the WTDOT board is set to ! and what channels instruments/valves are connected to. ! These commands are for turning on or off the gas pump that circulates gases to the detectors. ! These are on: WTDOTport = 9 character(len=1), parameter:: WTDOT = 'A' ! The WTDOT board that the Red Hat valves and SL pump are connected to. character(len=3), parameter:: N2DryOn = WTDOT//'LA' ! Set channel A on Board to low (i.e., turn it on ) character(len=3), parameter:: N2DryOff = WTDOT//'HA' ! Set channel A on Board to high (i.e., turn it off) character(len=3), parameter:: gasPumpOn = WTDOT//'LB' ! Set channel B on Board to low (i.e., turn it on ) character(len=3), parameter:: gasPumpOff = WTDOT//'HB' ! Set channel B on Board to high (i.e., turn it off) character(len=3), parameter:: CH4mixOn = WTDOT//'LC' ! Set channel C on Board to low (i.e., turn it on ) character(len=3), parameter:: CH4mixOff = WTDOT//'HC' ! Set channel C on Board to high (i.e., turn it off) character(len=3), parameter:: N2On = WTDOT//'LD' ! Set channel D on Board to low (i.e., turn it on ) character(len=3), parameter:: N2Off = WTDOT//'HD' ! Set channel D on Board to high (i.e., turn it off) character(len=3), parameter:: AirOn = WTDOT//'LE' ! Set channel E on Board to low (i.e., turn it on ) character(len=3), parameter:: AirOff = WTDOT//'HE' ! Set channel E on Board to high (i.e., turn it off) ! Some WeederTech WTDAC commands. These are based on which channel the WTDAC board is set to ! and what channels instruments are connected to. ! These commands are for setting the voltage on the cole palmer pump, which I'll probably not need ! These are on: WTDACport = WTDOTport = 9 character(len=1), parameter:: WTDAC = 'B' ! The WTDAC is plugged into the WTDOT board, but on address B character(len=3), parameter:: pumpInV = WTDAC//'VA' ! Get the current voltage output and 1/100's of a volt. ! adding a four (or less) digit integer to this string sets the volatage ! Some WeederTech WTAIN board 2 commands. These are based on which channel the WTAIN board is set to ! and what channels instruments/valves are connected to. ! This reads the voltage output of the cole palmer pump to get the flow rate. ! These are on: WTAIN2port = WTDOTport = 9 character(len=1), parameter:: WTAIN2 = 'C' ! The WTAIN 2 board that the cole parmer pump is connected to character(len=3), parameter:: pumpOutV = WTAIN2//'RA' ! Read channel A on board (voltage output on pump) ! Some WeederTech WTAIN commands. These are based on which channel the WTAIN board is set to ! and what channels instruments/valves are connected to. ! These are on: WTAINport = 3 character(len=1), parameter:: WTAIN = 'A' ! The WTAIN board that the pH and DO probes are connected to character(len=3), parameter:: pHMC1 = WTAIN//'RA' ! Read channel A on board (pH of MC1) character(len=3), parameter:: DOMC1 = WTAIN//'RB' ! Read channel B on board (DO of MC1) character(len=3), parameter:: pHMC2 = WTAIN//'RC' ! Read channel C on board (pH of MC2) character(len=3), parameter:: DOMC2 = WTAIN//'RD' ! Read channel D on board (DO of MC2) character(len=1), parameter:: mode = '1' ! Set to mode 1 for all channels on WTAIN (-8.000 to +10.000 V) character(len=1), parameter:: dec = '0' ! Set Decimal to 0 on all channels of WTAIN (no decimal, value in mV) ! These are for control of the MKS 647C MFC power supply integer, parameter:: noMFC = 8 ! Number of MFC 647C can control (either 4 or 8) ! Just handle the first 10 types. real(4), parameter:: MFCrangeValues(1:10) = (/1.,2.,5.,10.,20.,50.,100.,200.,500.,1000./) ! This needs to be edited if MFC > 1 SLM integer, parameter:: MKSloopWait = 10 ! number of seconds to wait between reading 647C when in monitor mode real(4) MFCranges(noMFC)! Ranges of the MFC recorded in the 647c real(4) MFCgcf(noMFC)! Gas correction factors recorded in the 647c ! Data to map responce of 647C to actual values ! Flow ranges: ! 0 = 1.000 SCCM, 20 = 1.000 SCFH ! 1 = 2.000 SCCM, 21 = 2.000 SCFH ! 2 = 5.000 SCCM, 22 = 5.000 SCFH ! 3 = 10.00 SCCM, 23 = 10.00 SCFH ! 4 = 20.00 SCCM, 24 = 20.00 SCFH ! 5 = 50.00 SCCM, 25 = 50.00 SCFH ! 6 = 100.0 SCCM, 26 = 100.0 SCFH ! 7 = 200.0 SCCM, 27 = 200.0 SCFH ! 8 = 500.0 SCCM, 28 = 500.0 SCFH ! 9 = 1.000 SLM, 29 = 1.000 SCFM ! 10 = 2.000 SLM, 30 = 2.000 SCFM ! 11 = 5.000 SLM, 31 = 5.000 SCFM ! 12 = 10.00 SLM, 32 = 10.00 SCFM ! 13 = 20.00 SLM, 33 = 20.00 SCFM ! 14 = 50.00 SLM, 34 = 50.00 SCFM ! 15 = 100.0 SLM, 35 = 100.0 SCFM ! 16 = 200.0 SLM, 36 = 200.0 SCFM ! 17 = 400.0 SLM, 37 = 500.0 SCFM ! 18 = 500.0 SLM, 38 = 30.00 SLM ! 19 = 1.000 SCMM, 39 = 300.0 SLM !================== Other parameters real, parameter:: badRead = -9.99 ! values to use for bad port reads. !real purgeTime ! Time to spend sampling one reactor (min). This is needed to purge detectors, etc. real loopTime ! How often to intitiate a complete sampling (min). This is entered as hours, but converted to nearist min. ! loopTime > purgeTime*(noSeq) integer infoUnit, datUnit, rcvUnit, ocUnit ! unit numbers for *.info, *.dat, *.rcv and *.oc files. integer, parameter:: noSeq = 3 ! The number of gases that need to be sampled in sequence. These may or may not be on the same valco port character*15, parameter:: okDigits = '+-0123456789. ,' integer seqPorts(noSeq), seqMCs(noSeq) ! see main program for def character*8 seqNames(noSeq) ! names of ports in sampling sequence. real seqPurgeTime(noSeq) ! This replaces purgeTime so that each the sampling for each gas can be specified. real o2Feed, co2Feed ! Concentrations of feed gas for MCs real co2Adj, o2Adj ! Offsets between calibrations determined by reading a known composition, such as air tank. integer noteFlag ! Is set to 1 when new note is entered. integer noteCnt ! moved to here real(8) tzero character filename*80 real(8) MCheadSpaceVol(noSeq), MCliqVol(noSeq), SLvol ! These should all be in Liters now real(8) SL_O2, SL_CO2, SL_o2_new, SL_co2_new ! concentrations of these gases in the sample loop. integer, parameter:: nOC = 11 real(8) ocVec(nOC) ! data stored in the OC file. See getOC subroutine integer, parameter:: nData = 10 ! number of data points in dataVec real(8) dataVec(nData) ! first 10 columns in the *.dat file. also see getOC routine real(8) dataMat(noSeq,10) real(8) flowSPMC ! the gas flow set points for the algae and digestor bioreactors logical tmpFlowUPMC1, tmpFlowUPMC2 ! if the flow set point has been changed due to low flow integer portMC1, portMC2 ! Valco ports for microcosms. integer portN2, portAir ! Valco ports top sample gases integer mfcMC1, mfcMC2 ! the MKS 647C controllers of the MC1, MC integer mfcAir ! the MKS 647C controllers for air into the holding tank that feeds mfcMC1 and mfcMC1. integer useGasMenu ! this is the gas menu that the MKS 647c controller will be set to for the experiment, usually 1 real(8) airSup ! the total air flow needs to be this fraction higher than the gas flow to all reactors (unitless) real(8) airPur ! This is the absolute increase to the total air flow when purging the sample loop (mL/min) real(8) airAdd ! This amount of flow is alway added to the total air flow. Note, this was added to allow some SES experiments to run. (set to 0 otherwise) character version*20, versionNew*20 character debugStr*1024, tempStr*1024 ! just using for debugging real(8) pH4, pH20, DO4, DO20 ! the pH and DO at 4 and 20 mA (set by Hamilton software for pH and DO probes) real(8) tempC ! reactor temperatures (C) !real(8) flowEx, maxFlowEx ! reactor exchange flow rate, and max allowed (L/d) ** note, ver 1.11 units have been changed from mL/d to L/d real(8) dilR ! Dilution rate of microcosms real(8) MCrpm(noSeq) ! RPMs of algal and digestor reactors real(8) minGasFlow ! if gas flow to reactors is less than minGasFlow, then the gas flow is temporarly increased during reactor sampling to this value. character(3) pHerror, DOerror ! used to set a read error for pH or DO namelist /recovery/ o2Feed, co2Feed namelist /recovery/ seqPurgeTime, loopTime namelist /recovery/ tzero, noteCnt, MCheadSpaceVol, MCliqVol, SLvol namelist /recovery/ airSup, airPur, airAdd namelist /recovery/ portMC1, portMC2, portN2, portAir namelist /recovery/ version namelist /recovery/ pH4, pH20, DO4, DO20 namelist /recovery/ mfcMC1, mfcMC2, mfcAir, useGasMenu namelist /recovery/ tempC, dilR namelist /recovery/ MCrpm namelist /recovery/ seqPorts, seqMCs, seqNames namelist /recovery/ minGasFlow ! Data declarations for console cursor access integer(HANDLE) fhandle logical logstat Type(T_CONSOLE_SCREEN_BUFFER_INFO) conbuf Type(T_COORD) dwCursorPosition contains subroutine writeRecovery ! This routine writes recovery info open(newunit=rcvUnit,file=trim(filename)//'.rcv',status='unknown', DELIM='APOSTROPHE') write(rcvUnit,nml=recovery) close(unit=rcvUnit) return end subroutine writeRecovery subroutine readRecovery ! This routine reads the recovery info open(newunit=rcvUnit,file=trim(filename)//'.rcv',status='old') read(rcvUnit,nml=recovery) close(unit=rcvUnit) return end subroutine readRecovery End Module CommParameters Program MonitorGasesMCP ! This Program is used to monitor the gas composition for the bioreactor setup for the DEB 2017 project ! with Julie and Ashley. use CommParameters implicit None integer iresult, i, j, portNo, byteCnt, ok2read integer dt(8), ifail, optNo, cntrl real(8) loopStartT, loopCurT, loopMin, beginT, endT, td character formStr*100, key*1, lineRead*80, tecStr*1000, longStr*150, ptN*2 logical keyHit, infoExists, datExists, rcvExists, ocExists, getOpt, testing real(8) eltime logical saveData character outStr*80 integer irow, ip integer, parameter:: on = 1, off = 0 ! \\\\\\\\\\\\\\\\\\\\\\\\\\\\\ Begin Program ///////////////////////////////////////// ! Program version versionNew = '1.3 (8-Feb-2019)' ! Parameters that are hardward dependent and unlikely to change during a run ! This are all saved in the recovery file too. portMC1 =1; portMC2 = 2; portN2 = 10; portAir = 10 ! Valco port numbers for the MCs and gases mfcMC1 = 1; mfcMC2 = 2 ! The 647C mass flow controllers that feed the MC1 and MC2 reactors ! Just feed air tank to mfcMC1, MC2, etc, no reservour mfcAir = 5 ! This set which MFC is used to feed the air to the air reservour useGasMenu = 1 ! this is the gas menu that the MKS 647c controller will be set to for the experiment, usually 1 ! There air flow parameters are saved in the recovery file, so can be changed there if these defaults are not what is wanted. ! This means once the program is started, it must be exited, then the recovery file edited, then restarted to use new values. ! *** Note, the air reservour is not being used. airSup = 1.25 ! the air flow needs to be this fraction higher than the gas flow to the two reactors airPur = 500.0 ! This is the absolute increase to the air flow when purging the sample loop with air (mL/min) airAdd = 0.0 ! This amount is added to the air flow. It should be zero unless doing something outside this experiment. tmpFlowUPMC1 = .false.; tmpFlowUPMC2 = .false. ! initialized these flags ! sample loop volume (L) Note 0.190 is when the CH4 detector was in-line, but now it is removed, so this is smaller ! Also, the Oxigraf analyzer was modified to remove internal gas chamber and pump, so the SL is now much small, but not sure how small ! so go with 20 mL, which may be too large SLvol = 0.020 pH4 = 0.; pH20 = 14. ! This is set by the Hamilton Device manager. Must be the same for all pH probes. (pH a 4 and 20 mA) DO4 = 0.; DO20 = 15. ! Set by Hamilton Device Manager for probes. Must be the same for all DO probes (DO at 4 to 20 mA, in mg/L) ! setup valco sampling (this seems to be calling out for a Type declaration...) seqPorts(1:noSeq) = [portAir, portMC1 , portMC2] seqNames(1:noSeq) = ['Air' , 'MC1' , 'MC2' ] ! Names of ports in seqPorts seqMCs(1:noSeq) = [0 , 1 , 1 ] ! those ports in seqPorts that correspond to reactors MCheadSpaceVol = 0 ! just set volumes to zero for now. MCliqVol = 0 ! Get the handle of the console fhandle = GetStdHandle(STD_OUTPUT_HANDLE) ! Get name to label data files write(6,'(a)') 'Program MonitorMCP Version: '//versionNew write(6,'(a,$)') 'Enter file name for data (no extension): ' read(5,'(a)') filename ! Three files are used: ! filename.info contains information (notes) about the run ! filename.dat Contains the collected data. ! If either files already exists, then data is appended (allows for restarts) ! filename.rcv Contains all the user entered data to restart program. ! See if the files exist inquire(file=trim(filename)//'.info' ,exist=infoExists) ! File that conaints general info, and entered notes inquire(file=trim(filename)//'.dat' ,exist=datExists) ! Main file with monitored data inquire(file=trim(filename)//'.rcv' ,exist=rcvExists) ! The recovery file used to restart inquire(file=trim(filename)//'.oc' ,exist= ocExists) ! Manually changed operating conditions, like temperature, dilution rate, etc. !open files if (infoExists) then write(6,*) ' **Warning**: file: ',trim(filename)//'.info',' exits. Will append data' open(newunit=infoUnit,file=trim(filename)//'.info',status='old',access='append') else open(newunit=infoUnit,file=trim(filename)//'.info',status='new') end if if (datExists) then write(6,*) ' **Warning**: file: ',trim(filename)//'.dat',' exits. Will append data' open(newunit=datUnit,file=trim(filename)//'.dat',status='old',access='append') else open(newunit=datUnit,file=trim(filename)//'.dat',status='new') end if if (ocExists) then write(6,*) ' **Warning**: file: ',trim(filename)//'.oc',' exits. Will append data' open(newunit=ocUnit,file=trim(filename)//'.oc',status='old',access='append') else open(newunit=ocUnit,file=trim(filename)//'.oc',status='new') end if ! Setup com ports write(6,*) 'Initializing COM ports ...' call initializePorts() ! sets up the WTAIN board operating parameters. Note, board retains these settings even if power is lost call setupWTAIN () ! Read the MKS 647C settings write(6,*) 'Getting operting parameters from MKS 647c controller ...' call get647Cparams () write(6,'(a)') 'Flow Ranges for MFCs reported by 647C:' write(6,'(a)') ' MFC 1 MFC 2 MFC 3 MFC 4 MFC 5 MFC 6 MFC 7 MFC 8' write(6,'(8(1x,f7.2)/)') (MFCranges(j),j=1,noMFC) write(6,'(a)') 'Gas Correction Factors for MFCs reported by 647C:' write(6,'(a)') ' MFC 1 MFC 2 MFC 3 MFC 4 MFC 5 MFC 6 MFC 7 MFC 8' write(6,'(8(1x,f7.2)/)') (MFCgcf(j),j=1,noMFC) ! Set the MKS 647c to gas menu set by useGasMenu call selectGasMenu (useGasMenu) ! Initialize the gas analyzer offsets (only needed if not sampling feed gas) o2Adj = 0.0; co2Adj = 0.0 ! See if a recovery file exists if (rcvExists) then write(6,'(a,$)') 'Recovery file found! Do you wish to use it (y/n) ?' read(5,'(a)') lineRead if (scan(lineRead,'yY') /= 0) then call readRecovery else call getProgramRunParams end if else call getProgramRunParams end if version = versionNew ! update the version number in the recovery file, all other parameters set above can be over written ! Allow users to enter info about run: call DATE_AND_TIME (values=dt) call julday(dt(1),dt(2),dt(3),dt(5),dt(6),real(dt(7)),td,ifail) td = td - tzero ! julian date referenced to start of experiment. write(infoUnit,'(a)') 'Program Version: '//version write(infoUnit,'(2(a,i2.2),a,i4,3(a,i2.2),a,f10.5,a)') & 'Program (Re)Started: ',dt(2),'/',dt(3),'/',dt(1),' ',dt(5),':',dt(6),':',dt(7),', time = ',td,' d' do i=1,noSeq write(infoUnit,'(3a,f5.2,a,i2)') 'Sample loop purge time for ',seqNames(i), ' (min): ', seqPurgeTime(i), '; On port: ',seqPorts(i) end do write(infoUnit,'(a,f5.2)') 'Loop time (hr): ', loopTime/60.0 write(infoUnit,'(a)') '--------------------------- Experiment Description ----------------------------' write(6,'(a)') 'Enter description of experiment. Blank line terminates entry.' do write(6,'(a,$)') '> ' read(5,'(a)') lineRead if (lineRead == ' ') exit write(infoUnit,'(a)') lineRead end do write(infoUnit,'(a)') '-------------------------------------------------------------------------------' write(infoUnit,*) ' ' ! Write tecplot header if this is a new data file if (.not. datExists) then ! tecStr = 'Variables = "M" "D" "Y" "Hr" "Min" "Sec" "O2 Alg Feed" "CO2 Alg Feed" "O2 offset" "CO2 offset L" "CO2 offset H" "CH4 offset L" "CH4 offset H"' tecStr = 'Variables = "M" "D" "Y" "Hr" "Min" "Sec" "O2 MC Feed" "CO2 MC Feed" "O2 offset" "CO2 offset"' longStr = ' "Time ## (d)" "Port ##" "Liq Vol ##" "Gas Vol ##" "SL Flow ## (sccm)" "Gas Flow ## (sccm)" "O2 ## (%)" "CO2 ## (%)"& & "pH ##" "DO ## (uM)"' i = 0 do j=1,noSeq if (seqMCs(j) == 0) cycle ! only save data assoicated with ports connected to MCs i = i + 1 ptN = 'M'//char(48+i) longStr(8:9) = ptN ! Time (julian day) longStr(22:23) = ptN ! Port longStr(35:36) = ptN ! Reactor Liq. vol (L) longStr(48:49) = ptN ! Reactor gas vol (L) longStr(61:62) = ptN ! Sample loop flow rate (sccm) longStr(82:83) = ptN ! Feed gas flow rate (sccm) longStr(97:98) = ptN ! O2 concentration (%) longStr(110:111) = ptN ! CO2 Concentration (%) longStr(122:123) = ptN ! pH longStr(130:131) = ptN ! DO (microM) tecStr = trim(tecStr)//longStr end do tecStr = trim(tecStr)//' "Notes"' write(datUnit,'(a)') tecStr write(datUnit,'(a)') 'Zone' end if ! Setup othe operating conditions file if (.not. ocExists) then tecStr = 'Variables = "M" "D" "Y" "Hr" "Min" "Sec" "Time" "Temp (C)" "Dilution Rate (L/d)" "MC1 RPM" "MC2 RPM"' write(ocUnit,'(a)') tecStr write(ocUnit,'(a)') 'Zone' end if ! Store the input info in a recovery file call writeRecovery ! turn everything off in case restarting from crash call pumpOff () do i=1,noSeq call purgeValve (seqNames(i), off) end do ! ------------------------------------------------------ ! -------------- Begin Test loop --------------------- ! ------------------------------------------------------ write(6,'(a,$)') 'Do you want to test gas sampling loop hardware/software? (y/n): ' read(5,'(a)') lineRead testing = .false. if (scan(lineRead,'yY') /= 0) testing = .true. do while (testing) Write(6,'(a)') 'Running a standard sampling, but with out purging' call pumpOn () write(6,'(a)') 'Gas pump should be on, check flow' do i=1, noSeq dataMat(i,2) = seqPorts(i) Call valcoControl(seqPorts(i)) ! Move to port i in sequence ! Open a calibration or purge gas via Red Hat valve if necessary call purgeValve (seqNames(i), on) ! read analyzers o2Adj = 0.0; co2Adj = 0.0! don't use offset here call readAnalyzers (seqNames(i), dataMat(i,:)) call getOC () ! Update time stamp in dataVec as well as O2, CO2 offsets SL_o2 = SL_o2_new; SL_co2 = SL_co2_new ! update gas composition in sample loop longStr = '(2(i2.2,''/''),i2,1x,2(i2.2,'':''),i2.2,1x,a8,##x,f5.0,2x,f4.1,3x,f5.2,3x,f5.2,3x,f6.2)' write(longStr(43:44),'(i2)') i ip = 8 if (seqMCs(i)==1) ip = 10 ! print out the DO and pH values too for bioreactors. if (i==1) write(6,'(a)') ' Date Time Gas/MC Flow O2(%) CO2(%) pH DO(uM) ' write(formStr,longStr) (int(dataVec(j)),j=1,2), mod(int(dataVec(3)),1000), (int(dataVec(j)),j=4,6), seqNames(i), real(dataMat(i,5)), (real(dataMat(i,j)),j=7,ip) if (seqMCs(i)==1) formStr(74:79) = pHerror//DOerror ! display error if one occured with pH or DO write(6,'(a)') formStr(1:79) ! turn off the current purge gas if it was on call purgeValve (seqNames(i), off) end do call pumpOff () write(6,'(a)') 'Gas pump should be off, check flow' write(6,'(a)') 'Finished test reads.' write(6,'(a$)') 'Test sample sequence again? (y/n): ' read(5,'(a)') lineRead testing = .false. if (scan(lineRead,'yY') /= 0) testing = .true. end do Write(6,'(/,a)') 'Main Sampling begining...' write(6,'(a)') 'Hit ESC at anytime to bring up Menu.' ! ------------------------------------------------------ ! -------------- Begin Sample loop --------------------- ! ------------------------------------------------------ noteFlag = 0 call writeOC () ! Save ocVec to *.oc file call pumpOff () ! make sure pump is off write(6,'(a)') 'Gas sample sequence has begun...' sampling: do ! Begin sequence for sampling. saveData = .true. ! Unless user intervenes, data will be stored. loopStartT = RTC() ! marks the time, in sec, that a sampling loop started readPort: do i=1, noSeq ! This do loop either measures the instruement offsets or reads data from a reactor ! Move to the valco port to the next in in sequence given by seqPorts(i) dataMat(i,2) = seqPorts(i) Call valcoControl(seqPorts(i)) ! Move to port i in sequence ! Open a calibration or purge gas via Red Hat valve if necessary call purgeValve (seqNames(i), on) ! turn sample loop gas pump on call pumpOn () beginT = RTC() purge: do ! Sleepy sleep for 10 sec. call SLEEP (10) ! See if ESC key was hit keyHit = PEEKCHARQQ ( ) if (keyHit) then !See if key hit is ESC, if is so exit. key = GETCHARQQ( ) if (key == ESC) then call pumpOff () ! turn pump off while in menu. call shortMenu(cntrl) select case (cntrl) case(1) ! just continue sampling port like nothing happened. call pumpOn () ! turn pump on and return to sampling. case(2) ! restart readPort sample loop, do not save anything call purgeValve (seqNames(i), off) ! turn off purge valve cycle sampling case(3) ! exit readPort sample loop, do not save anything saveData = .false. call purgeValve (seqNames(i), off) exit readPort case(99) ! exit program write(6,'(a,$)') 'Exit program? (y/n): ' read(5,'(a)') lineRead if (scan(lineRead,'yY') /= 0) then call purgeValve (seqNames(i), off) exit sampling end if call pumpOn () ! turn pump on and return to sampling. end select ! if neither case is selected, just continue sampling port end if end if endT = RTC() if ( (endT-beginT)/60. >= seqPurgeTime(i) ) exit purge ! print update of gas values. call readAnalyzers (seqNames(i), dataMat(i,:)) ! get the cursor position logstat = GetConsoleScreenBufferInfo(fhandle, conbuf) ! write current reading out at the same location longStr = '(''Purge t:'',f4.1,,'' min'','' Gas:'',a8,'' Flow: '',f6.1,'' O2:'',f6.2,'' CO2:'',f7.3,$)' write(6,longStr) (endT-beginT)/60., seqNames(i), real(dataMat(i,5)), (real(dataMat(i,j)),j=7,8) ! put the cursor back to where it was logstat = SetConsoleCursorPosition(fhandle, conbuf.dwCursorPosition) end do purge ! SL has been purged seqPurgeTime, so read analyzers to get value to store call readAnalyzers (seqNames(i), dataMat(i,:)) call getOC () ! Only using this to update time stamp in dataVec for printing below. SL_o2 = SL_o2_new; SL_co2 = SL_co2_new ! update gas composition in sample loop longStr = '(2(i2.2,''/''),i2,1x,2(i2.2,'':''),i2.2,1x,a8,##x,f5.0,2x,f4.1,3x,f5.2,3x,f5.2,3x,f6.2)' write(longStr(43:44),'(i2)') i ip = 8 if (seqMCs(i)==1) ip = 10 ! print out the DO and pH values too for bioreactors. write(formStr,longStr) (int(dataVec(j)),j=1,2), mod(int(dataVec(3)),1000), (int(dataVec(j)),j=4,6), seqNames(i), real(dataMat(i,5)), (real(dataMat(i,j)),j=7,ip) if (i==1) write(6,'(a)') ' Date Time Gas/MC Flow O2(%) CO2(%) pH DO(uM) ' if (seqMCs(i)==1) formStr(74:79) = pHerror//DOerror ! display error if one occured with pH or DO write(6,'(a)') formStr(1:79) ! turn off the current purge gas if it was on call purgeValve (seqNames(i), off) end do readPort ! Turn SL gas pump off call pumpOff () ! Store data in *.dat file (designed for Tecplot read) if (saveData) call writeDat () ! Now wait loopTime until time to begin next total sampling loopWait: do ! just move valco to first port Call valcoControl(seqPorts(1)) loopCurT = RTC() ! get current time, in sec, and check loop time. loopMin = (loopCurT-loopStartT)/60.0 if ( loopMin >= loopTime ) exit loopWait ! get the cursor position logstat = GetConsoleScreenBufferInfo(fhandle, conbuf) write(6,'(a,f7.2,a,$)') 'Time to next sampling: ',loopTime-loopMin, & ' (min). Hit ESC for LONG menu' logstat = SetConsoleCursorPosition(fhandle, conbuf.dwCursorPosition) ! Sleepy sleep for 10 sec. call SLEEP (10) ! See if ESC key was hit keyHit = PEEKCHARQQ ( ) if (keyHit) then !See if key hit is ESC, if is so exit. key = GETCHARQQ( ) if (key == ESC) then call longMenu(cntrl) select case (cntrl) case(1,3:12) ! Continue to wait for next sample loop start. write(6,'(a,/)') ' ** Returing to sampling, press ESC for menu' cycle loopWait case(2) ! restart sample loop BEFORE loopTime has expired write(6,'(a,/)') ' ** Begining sampling sequence, press ESC for menu' exit loopWait case(99) ! exit program write(6,'(a,$)') 'Exit program? (y/n): ' read(5,'(a)') lineRead if (scan(lineRead,'yY') /= 0) exit sampling cycle loopWait end select ! if no case is selected, just continue to wait (shouldn't happen) end if end if end do loopWait end do sampling ! ------------------------------------------------------ ! -------------- End Main Sampling Loop ----------------- ! ------------------------------------------------------ ! make sure pump is off and feed 2 sample valve is closed. ! however, leave the feed gas switcing valve unchanged. ! place valco port onto purging with vent gas call pumpOff () Call valcoControl(seqPorts(1)) ! Just move to first port in seq. (no real reason why) do i=1,noSeq call purgeValve (seqNames(i), off) end do ! Release all the ports iresult = SPORT_RELEASE (oxigrafPort) iresult = SPORT_RELEASE (valcoPort ) iresult = SPORT_RELEASE (mfmPort ) iresult = SPORT_RELEASE (mfcPort ) iresult = SPORT_RELEASE (WTDOTport ) iresult = SPORT_RELEASE (WTAINport ) ! Although recovery file should be up to date, write anyway call writeRecovery close(unit=infoUnit) close(unit= datUnit) close(unit= ocUnit) stop end program MonitorGasesMCP subroutine writeDat() ! Write the output to the *.DAT file use CommParameters implicit none ! local declarations character longStr*120 integer i, j, iresult longStr = '(\,2(f3.0,1x),f5.0,3(1x,f3.0),4(1x,f7.4))' write(datUnit,longStr) (dataVec(j),j=1,nData) longStr = '(\,1x,f10.5,1x,f4.0,2(1x,f5.2),1x,f6.1,1x,f6.2,1x,f6.2,1x,f7.3,1x,f6.2,1x,f7.2)' do i=1,noSeq ! only save data associated with microcosms (other data is in dataVec) if (seqMCs(i) == 0) cycle write(datUnit,longStr) dataMat(i,1:10) end do write(datUnit,'(1x,i3)') noteCnt*noteFlag noteFlag = 0 ! Generate tecplot images for web page by calling dos command batch file. longStr = 'start "ExportImages" cmd /C exportImages.bat '//trim(filename)//'.dat' iresult = system(longStr) ! this allows the program to return without waiting. return end subroutine writeDAT subroutine shortMenu(optNo) use CommParameters, only: infoUnit implicit none integer nCnt, optNo ! Local declarations integer dt(8), input logical getOpt character formStr*80, lineRead*80, outStr*80 CALL BEEPQQ(1000, 500) getOpt = .true. opt: do while (getOpt) write(6,'(/)') write(6,'(a)') 'Sampling Paused; Options:' write(6,'(a)') ' 1. Return to sampling.' write(6,'(a)') ' 2. Restart sample loop imediately after entering a note.' write(6,'(a)') ' 3. Exit current sampling w/o saving this data point.' write(6,'(a)') ' 99. Exit program.' read(5,*) optNo select case (optNo) case(1) ! Just return like nothing happened. getOpt = .false. write(6,*) ' Returning to sampling, press ESC for menu' write(6,*) ' ' case(2) ! Restart sample loop and the entering of a note call saveNote () getOpt = .false. write(6,*) ' Returning to sampling, press ESC for menu' write(6,*) ' ' case(3) write(6,*) ' Restarting sampling, press ESC for menu' write(6,*) ' ' getOpt = .false. case(99) getOpt = .false. case default write(6,*) ' ** Option not recognized, try again **' end select end do opt return end subroutine shortMenu subroutine longMenu(optNo) use CommParameters implicit none integer optNo ! Local declarations integer dt(8), input, i logical getOpt character formStr*80, lineRead*80, outStr*80 CALL BEEPQQ(1000, 500) getOpt = .true. opt: do while (getOpt) write(6,'(//)') write(6,'(a)') 'Sampling Paused; Options:' write(6,'(a)') ' 1. Return to sampling.' write(6,'(a)') ' 2. Restart sample loop IMMEDIATELY after entering a note.' write(6,'(a)') ' 3. Change gas feed rates.' write(6,'(a)') ' 4. Enter new feed gas compositions.' write(6,'(a)') ' 5. Enter new dilution rate for reactors.' write(6,'(a)') ' 6. Enter new reactor liq. and gas volumes.' write(6,'(a)') ' 7. Enter new reactor RPMs.' write(6,'(a)') ' 8. Enter new reactor Temp value.' write(6,'(a)') ' 9. Enter a note, but continue to wait for next sample event.' write(6,'(a)') ' 10. Begin recording gas analyzer readings.' write(6,'(a)') ' 11. Begin monitoring all MFC on MKS 647c (sampling stops while active).' write(6,'(a)') ' 12. Turn an MFC on or off.' write(6,'(a)') ' 99. Exit program' read(5,*) optNo select case (optNo) case(1) getOpt = .false. case(2) ! Enter a note and start sampling MCs imediatly on return. call saveNote () getOpt = .false. case (3) ! Change gas feed rate on MFC via do call changeSetpoint () write(6,'(a,$)') 'Change another MFC set point? (y/n): ' read(5,'(a)') lineRead if (scan(lineRead,'nN') /= 0) exit end do call saveNote () getOpt = .false. case(4) ! Get concentrations of feed gas write(6,'(a,$)') 'Change Air feed gas comp? (y/n): ' read(5,'(a)') lineRead if (scan(lineRead,'yY') /= 0) then write(6,'(a)') 'Enter Air feed gas concentrations:' write(6,'(a,$)') 'O2 (%): ' read(5,*) o2Feed write(6,'(a,$)') 'CO2 (%): ' read(5,*) co2Feed end if call saveNote () call writeRecovery ! update recovery file getOpt = .false. case (5) ! Specify what the new dilution rate is. Note, for now this must be done ! manually by changing the pump flow rates, this just store the new value call writeOC () ! save OC values before changing write(*,'(a,$)') 'Enter new dilution rate (1/d): ' read(*,*) dilR call writeOC () ! save change in OC call writeRecovery ! update recovery file call saveNote () getOpt = .false. case(6) ! Enter new values for MC headspace gas volume (mL) do i=1,noSeq if (seqMCs(i) == 0) cycle ! only ports connected to reactors matter write(6,'(3a,$)') 'Enter Liquid volume (L) for reactor ',trim(seqNames(i)),': ' read(5,*) MCliqVol(i) write(6,'(3a,$)') 'Enter Gas volume (L) for reactor ',trim(seqNames(i)),': ' read(5,*) MCheadSpaceVol(i) end do call writeRecovery ! update recovery file call saveNote () getOpt = .false. case(7) ! New value for Reactor RPMs call writeOC () ! save OC values before changing do i=1,noSeq if (seqMCs(i) == 0) cycle ! only ports connected to reactors matter write(6,'(3a,$)') 'Enter RPM for reactor ',trim(seqNames(i)),': ' read(5,*) MCrpm(i) end do call writeOC () ! save change in OC call writeRecovery ! update recovery file call saveNote () getOpt = .false. case(8) ! Changed growth chamber Temp call writeOC () ! save OC values before changing write(6,'(a,$)') 'Enter Temperature of growth chamber (C): ' read(5,*) tempC call writeOC () ! save change in OC call writeRecovery ! update recovery file call saveNote () getOpt = .false. case(9) ! Pause to allow entering of a note ! Unlike option 2, this just continues to wait until next sampling event. call saveNote () getOpt = .false. case(10) ! Save gas anlyzer data to a specified file call readAndStoreAnalzers () write(6,'(/,a)') ' ** Returing to sampling, press ESC for menu' getOpt = .false. case(11) ! Monitor MFC on MKS 647c call monitorMFC () getOpt = .false. case(12) ! Turn an MFC on or off via MKS 647c call MFCsOnOff () getOpt = .false. case(99) getOpt = .false. case default write(6,*) ' ** Option not recognized, try again **' end select end do opt return end subroutine longMenu subroutine saveNote () ! Writes a note to the info file, and increments note number, and sets flag use CommParameters implicit none ! local declarations integer dt(8), input, i, ifail character formStr*80, lineRead*80 real(8) td ! time in days noteCnt = noteCnt + 1 ! increment the number of notes noteFlag = 1 ! indicates a note has been made during this period call DATE_AND_TIME (values=dt) call julday(dt(1),dt(2),dt(3),dt(5),dt(6),real(dt(7)),td,ifail) td = td - tzero ! julian date referenced to start of experiment. write(formStr,'(2(a,i2.2),a,i4,3(a,i2.2),a,f10.5,a)') & ' (',dt(2),'/',dt(3),'/',dt(1),' ',dt(5),':',dt(6),':',dt(7),' time = ',real(td),' d)' write(infoUnit,'(a,i3,a)') 'Note Number: ', noteCnt, trim(formStr) write(6,'(a,i3)') 'Enter description for Note: ',noteCnt write(6,'(a)') 'Enter blank line to return to sampling (calibrate before returning)' do write(6,'(a,$)') '> ' read(5,'(a)') lineRead if (lineRead == ' ') exit write(infoUnit,'(a)') lineRead end do write(infoUnit,'(a)') '-------------------------------------------------------------------------------' write(infoUnit,*) ' ' return end subroutine saveNote subroutine getOC () ! Set the ocVec and dataVec arrays that specifiy the operating conditions use CommParameters implicit none ! local declarations integer dt(8), ifail, name2seq ! Get time stamp and julian time call DATE_AND_TIME (values=dt) dataVec(1:6) = (/dble(dt(2)),dble(dt(3)),dble(dt(1)),dble(dt(5)),dble(dt(6)),dble(dt(7))/) ocVec(1:6) = dataVec(1:6) call julday(dt(1),dt(2),dt(3),dt(5),dt(6),real(dt(7)),ocVec(7),ifail) ocVec(7) = ocVec(7) - tzero ! Set rest of dataVec dataVec(7: 8) = [o2Feed, co2Feed] dataVec(9:nData) = [o2Adj, co2Adj] ! Set the rest of ocVec ocVec(8:11) = [tempC, dilR, MCrpm(name2seq('MC1')), MCrpm(name2seq('MC2'))] return end subroutine getOC subroutine writeOC () ! Write the output to the *.OC file. This gets called every time ! a change is made to the operating conditions ! OC variables are: !'Variables = "M" "D" "Y" "Hr" "Min" "Sec" "Time" "Temp (C)" "Dilution Rate (L/d)" "MC1 RPM" "MC2 RPM"' use CommParameters implicit none ! local declarations character longStr*120 call getOC () ! update the ocVec array longStr = '(2(f3.0,1x),f5.0,3(1x,f3.0),1x,f11.6,1x,f5.2,1x,f5.2,2(1x,f6.1))' write(ocUnit,longStr) ocVec(1:nOC) return end subroutine writeOC subroutine purgeValve (name, onoff) ! Turns a purge gas valve on or off use CommParameters implicit none character*(*) name ! name of the purge gas integer onoff ! 1 for on; 0 for off ! local declarations real(8) flowRate, fR1, fR2 select case (name) case('Air') ! Get the total air flow to all reactors !call getGasFlow (mfcMC1, fR1) ! get the flow rate to the MC1 reactor !call getGasFlow (mfcMC2, fR2) ! get the flow rate to the MC2 reactor !flowRate = fR1 + fR2 ! total air flow to both reactors if (onoff == 1) then ! turn on valve call redHat(AirOn) ! Increase air feed rate to Air tank (not using now) ! call changeAirSupply (flowRate + airAdd + airPur) ! adds airPur to the algal sparging rate else !turn off valve call redHat(AirOff) ! Return air feed rate to Air tank to nominal value !call changeAirSupply (flowRate*airSup + airAdd) ! air supply must be slightly higher than sparging rate to reactors. end if case('MC1') if (onoff == 1) then ! If flow rate is less than minGasFlow, then increase both flow to MC1 call getGasFlowSP (mfcMC1, flowSPMC) ! get the current set point for MC1 *** it is assumed this is the same for MC2 if (flowSPMC < minGasFlow) then ! flow must be increased to minGasFlow, and the air supply must be increased as well. Note, MC2 remains at set point. !call changeAirSupply ((minGasFlow+flowSPMC)*airSup + airAdd) ! air supply must be slightly higher that sparging rate. call changeMFCsp (mfcMC1, minGasFlow) tmpFlowUPMC1 = .true. end if else ! if flow rate was turned up for sampling, return flow to it's previous rate. if (.not. tmpFlowUPMC1) return call changeMFCsp (mfcMC1, flowSPMC) ! return to original flow !call changeAirSupply (2.*flowSPMC*airSup + airAdd) ! air supply must be slightly higher that sparging rate. tmpFlowUPMC1 = .false. end if case('MC2') if (onoff == 1) then ! If flow rate is less than minGasFlow, then increase both flow to MC2 and air supply flow call getGasFlowSP (mfcMC2, flowSPMC) ! get the current set point for MC2 *** it is assumed this is the same for MC1 if (flowSPMC < minGasFlow) then ! flow must be increased to minGasFlow, and the air supply must be increased as well. Note, MC1 remains at set point. !call changeAirSupply ((minGasFlow+flowSPMC)*airSup + airAdd) ! air supply must be slightly higher that sparging rate. call changeMFCsp (mfcMC2, minGasFlow) tmpFlowUPMC2 = .true. end if else ! if flow rate was turned up for sampling, return flow to it's previous rate. if (.not. tmpFlowUPMC2) return call changeMFCsp (mfcMC2, flowSPMC) ! return to original flow !call changeAirSupply (2.*flowSPMC*airSup + airAdd) ! air supply must be slightly higher that sparging rate. tmpFlowUPMC2 = .false. end if case('N2') if (onoff == 1) then ! turn on valve call redHat(N2On) else !turn off valve call redHat(N2Off) end if case('none') ! no need to do anything case default write(6,*) 'Error: invalid CASE calling purgeValve!' end select return end subroutine purgeValve subroutine redHat (cmdStr) ! Issue a on or off command to the WTDOT to turn off or on a solenoid valve use CommParameters implicit none character*(*) cmdStr ! command string to set a channel low (on) or high (off) ! local declarations character outStr*80 call writeWT(WTDOTport, cmdStr) ! get responce, which would just be the return of command call readWT(WTDOTport, outStr) if (outStr /= cmdStr) then write(6,'(2a)') 'WARNING:: error setting: ', trim(cmdStr) write(6,'(2a)') ' WTDOT Output response was: ', trim(outStr) end if return end subroutine redHat Subroutine readAnalyzers (name, dvec) ! This routine assumes the valco port had been moved to the appropriate port and ! the sample loop has been purged/run for the appropriate time and any external ! gases have been turned on (such as air). use CommParameters implicit none character*(*) name ! used to select what to return. See case below real(8) dvec(*) ! should have a dimension of at least 14 when called. ! dvec stores data in the following indexes ! 1: Julian day (relative to start of experiment) ! 2: Not modified ! 3: Set by reactor liq volume ! 4: Set by reactor gas volume ! 5: Sample loop flow rate ! 6: gas flow rate for reactors ! 7: O2, either raw and corrected ! 8: CO2, either raw and corrected ! 9: pH for reactor ! 10: DO for reactor !local declarations integer dt(8), ifail, i, name2seq real flow, o2, co2 ! Get time stamp and julian time call DATE_AND_TIME (values=dt) call julday(dt(1),dt(2),dt(3),dt(5),dt(6),real(dt(7)),dvec(1),ifail) dvec(1) = dvec(1) - tzero ! julian date referenced to start of experiment. ! Zero out the liq and gas reactor volumes (this will be set below if needed). dvec(3) = 0. dvec(4) = 0. ! Sample Mass flow meter call readMassFlowMeter (flow) dvec(5) = dble(flow) ! Sample oxigraph call readOxigraf(o2, co2) dvec(7) = dble(o2) dvec(8) = dble(co2) ! Zero out pH and DO in dvec dvec(9) = 0.0; dvec(10) = 0.0 ! Determine what to do based on name select case (name) case ('Air') ! Air is used to purge SL with air and get offsets for O2, CO2 o2Adj = o2 - o2Feed co2Adj = co2 - co2Feed SL_o2_new = o2Feed SL_co2_new = co2Feed case ('MC1', 'MC2') ! Reactor being samples ! Air should have been already run to get the instruement offsets ! Get the reactor liq and gas volumes dvec(3) = MCliqVol(name2seq(name)) dvec(4) = MCheadSpaceVol(name2seq(name)) dvec(7) = dvec(7) - dble( o2Adj) dvec(8) = dvec(8) - dble(co2Adj) ! Store the observed concentration to use for the next SL values SL_o2_new = dvec(7) SL_co2_new = dvec(8) ! Correct measurement for dulition of MC headspace by sample loop gas. dvec(7) = dvec(7)*(1.0 + SLvol/MCheadSpaceVol(name2seq(name))) - SL_O2 *SLvol/MCheadSpaceVol(name2seq(name)) dvec(8) = dvec(8)*(1.0 + SLvol/MCheadSpaceVol(name2seq(name))) - SL_CO2*SLvol/MCheadSpaceVol(name2seq(name)) ! Get gas flow rate, pH and DO for appropriate reactor ! However, if gas flow rate was set to less than minGasFlow, then attempt to store the set flow, not the increased flow if (name == 'MC1') then call getGasFlow (mfcMC1, dvec(6)) if (tmpFlowUPMC1) then ! gas flow was increased to minGasFlow just during sampling, so report nominal flow dvec(6) = dvec(6) - minGasFlow + flowSPMC end if call readpH(pHMC1, dvec(9)) call readDO(DOMC1, dvec(10)) else call getGasFlow (mfcMC2, dvec(6)) if (tmpFlowUPMC2) then ! gas flow was increased to minGasFlow just during sampling, so report nominal flow dvec(6) = dvec(6) - minGasFlow + flowSPMC end if call readpH(pHMC2, dvec(9)) call readDO(DOMC2, dvec(10)) end if case ('N2') !dvec(7) = dvec(7) - dble(o2Adj) !dvec(8) = dvec(8) - dble( co2Adj_L - (co2Adj_H - co2Adj_L)*co2/co2Feed_Alg ) !dvec(9) = dvec(9) - dble( ch4Adj_L - (ch4Adj_H - ch4Adj_L)*ch4/ch4Mix ) ! In this version, N2 is not being used in the sampling sequence, but might be used ! just for testing things. So nothing much to do than update the values of the gas in the sample loop SL_o2_new = dvec(7) SL_co2_new = dvec(8) case ('Raw') ! Used when getting raw output from analyzers usually for calibration ! Not really necessary, but update SL gas composition. SL_o2_new = dvec(7) SL_co2_new = dvec(8) case default ! This should not happen write(6,*) '**Warning** readAnalyzers bad case selection, returning' return end select return end Subroutine readAnalyzers subroutine getProgramRunParams use CommParameters implicit none ! This routine get the program run parameters from the user ! Note, these parameters are latter saved in a recovery file that will ! be read in. ! Local declarations character lineRead*80 integer dt(8), i, ifail real TinHours integer t0day, t0month, t0year ! date to base tzero on. ! Get concentrations of feed gas write(6,'(a)') 'Enter Air feed gas concentrations:' write(6,'(a,$)') 'O2 (%): ' read(5,*) o2Feed write(6,'(a,$)') 'CO2 (%)): ' read(5,*) co2Feed ! Enter values for MC headspace gas volume (mL) do i=1,noSeq if (seqMCs(i) == 0) cycle ! only ports connected to reactors matter write(6,'(3a,$)') 'Enter Liquid volume (L) for reactor ',trim(seqNames(i)),': ' read(5,*) MCliqVol(i) write(6,'(3a,$)') 'Enter Gas volume (L) for reactor ',trim(seqNames(i)),': ' read(5,*) MCheadSpaceVol(i) end do ! New value for Reactor RPMs do i=1,noSeq if (seqMCs(i) == 0) cycle ! only ports connected to reactors matter write(6,'(3a,$)') 'Enter RPM for reactor ',trim(seqNames(i)),': ' read(5,*) MCrpm(i) end do ! Changed growth chamber Temp write(6,'(a,$)') 'Enter Temperature of growth chamber (C): ' read(5,*) tempC ! Get dilution rate for chemostats write(*,'(a,$)') 'Enter dilution rate of chemostats (1/d): ' read(*,*) dilR ! Change gas feed rate on MFC via write(6,'(a)') 'Gas MFC can be set here, or manually.' write(6,'(a,$)') 'Do you want to set one now (y/n)? [N]: ' read(5,'(a)') lineRead if (scan(lineRead,'yY') /= 0) then do call changeSetpoint () write(6,'(a,$)') 'Change another MFC set point? (y/n): ' read(5,'(a)') lineRead if (scan(lineRead,'nN') /= 0) exit end do end if ! Get the minimum gas flow rate to reactors. This is needed because the sample loop leaks ! some (around 30 mL/min currently), so if flow to a reactor is less than this, then some ! air will flow into the reactor via it's exit. To prevent this, gas flow is increased during ! the sampling period. write(6,'(a,$)') 'Enter minimum gas flow rate to bioreactors (mL/min): ' read(5,*) minGasFlow ! Get time to collect a sample write(6,'(a)') 'Enter times to purge and sample the following gases:' do i=1, noSeq write(6,'(a,$)') ' Purge time for ', seqNames(i),' (min): ' read(5,*) seqPurgeTime(i) end do ! Get time to wait to purge gas samplers write(6,'(a,$)') 'Enter how often to initiate sampling of reactors (hrs): ' read(5,*) TinHours loopTime = TinHours*60.0 ! loopTime is stored as min., but input from user is in hours. if (sum(seqPurgeTime(1:noSeq)) > loopTime) then write(6,*) 'Warning, total gas sample time exceeds sample loop time!' write(6,'(a,f5.1,a)') ' Effective sample time will be: ', sum(seqPurgeTime(1:noSeq))/60, '(hr)' end if ! Get date for zero time write(6,'(a,$)') 'Enter month, day, year for Tzero (return to use today): ' read(5,'(a)') lineRead if (lineRead == ' ') then call DATE_AND_TIME (values=dt) t0day = dt(3) t0month = dt(2) t0year = dt(1) else read(lineRead,*) t0month, t0day, t0year end if ! Set time zero based on above date. This will be used to ease tecplot graphing call julday(t0year,t0month,t0day,0,0,0.0,tzero,ifail) ! Get number to start notes write(6,'(a$)') 'Number to begin note count (hit return to start at 1): ' read(5,'(a)') lineRead if (lineRead == ' ') then noteCnt = 0 else read(lineRead,*) noteCnt end if return end subroutine getProgramRunParams subroutine initializePorts() !This routine sets up communication to equipment attached to RS 232 Serial Ports. ! 20 Mar 2010 Ver 2: Changed setup of valco port. ! 03 Aug 2010 Ver 2.1: Added setup of WTDOT board ! 09 Apr 2015 Ver 2.2: Added setup of WTAIN board use CommParameters implicit None integer iresult integer baud, parity, dbits, sbits ! First Cancel communications to all ports iresult = SPORT_CANCEL_IO (oxigrafPort) iresult = SPORT_CANCEL_IO (valcoPort) iresult = SPORT_CANCEL_IO (mfmPort) iresult = SPORT_CANCEL_IO (WTDOTport) iresult = SPORT_CANCEL_IO (WTAINport) iresult = SPORT_CANCEL_IO (mfcPort) ! Purge the serial ports iresult = SPORT_PURGE (oxigrafPort, (PURGE_TXABORT .or. PURGE_RXABORT .or. PURGE_TXCLEAR .or. PURGE_RXCLEAR)) iresult = SPORT_PURGE (valcoPort, (PURGE_TXABORT .or. PURGE_RXABORT .or. PURGE_TXCLEAR .or. PURGE_RXCLEAR)) iresult = SPORT_PURGE (mfmPort, (PURGE_TXABORT .or. PURGE_RXABORT .or. PURGE_TXCLEAR .or. PURGE_RXCLEAR)) iresult = SPORT_PURGE (WTDOTport, (PURGE_TXABORT .or. PURGE_RXABORT .or. PURGE_TXCLEAR .or. PURGE_RXCLEAR)) iresult = SPORT_PURGE (WTAINport, (PURGE_TXABORT .or. PURGE_RXABORT .or. PURGE_TXCLEAR .or. PURGE_RXCLEAR)) iresult = SPORT_PURGE (mfcPort, (PURGE_TXABORT .or. PURGE_RXABORT .or. PURGE_TXCLEAR .or. PURGE_RXCLEAR)) ! Connect to all ports iresult = SPORT_CONNECT (oxigrafPort,DL_TERM_CRLF) !Oxigraf output terminated by crlf ! For Valco, toss CR from string on read, adds CR to write string, and end a read when a CR is encountered in buffer. iresult = SPORT_CONNECT (valcoPort,(DL_TOSS_CR .or. DL_OUT_CR .or. DL_TERM_CR)) iresult = SPORT_CONNECT (mfmPort ,(DL_OUT_CR .or. DL_OUT_LF .or. DL_TERM_CRLF)) !MKS 660B I/O Terminated with CRLF iresult = SPORT_CONNECT (WTDOTport,(DL_TOSS_CR .or. DL_OUT_CR .or. DL_TERM_CR)) iresult = SPORT_CONNECT (WTAINport,(DL_TOSS_CR .or. DL_OUT_CR .or. DL_TERM_CR)) ! MKS 647c add CR LF to writes, drop CR and LF from reads, and end a read when CR/LF is encountered. ! iresult = SPORT_CONNECT (mfcPort, (DL_OUT_CR .or. DL_OUT_LF .or. DL_TERM_CRLF .or. DL_TOSS_CR .or. DL_TOSS_LF)) ! Keep the characters on input, this allows them to be removed. iresult = SPORT_CONNECT (mfcPort, (DL_OUT_CR .or. DL_OUT_LF .or. DL_TERM_CRLF)) ! Set communcation specifics on all open ports baud = 9600; parity = 0; dbits = 8; sbits = 0 !(note, sbits = 0 means stop bits = 1) iresult = SPORT_SET_STATE (oxigrafPort , baud, parity, dbits, sbits) iresult = SPORT_SET_STATE (valcoPort , baud, parity, dbits, sbits) iresult = SPORT_SET_STATE (mfmPort , baud, parity, dbits, sbits) iresult = SPORT_SET_STATE (WTDOTport , baud, parity, dbits, sbits) iresult = SPORT_SET_STATE (WTAINport , baud, parity, dbits, sbits) iresult = SPORT_SET_STATE (mfcPort , baud, parity, dbits, sbits) ! Set the oxigraf to report once ! Only print info out once (ie. report period) iresult = SPORT_WRITE_DATA (oxigrafPort, ESC//'P0;', 0) return end subroutine initializePorts subroutine openUnit (iunit, promptStr) ! This opens a file for data output. implicit none integer iunit ! the unit # that is opened character promptStr*(*) ! String to prompt user with ! Local declarations character fname*80, yesno*3 logical fileExists integer iovar do write(6,'(a,$)') promptStr read(5,'(a)') fname ! See if the files exist inquire(file=trim(fname), exist=fileExists) if (fileExists) then write(6,'(a,$)') 'File exists, overwrite (y/n): ' read(5,'(a)') yesno if (scan(yesno,'yY') /= 0) then open(newunit=iunit,file=trim(fname),status='old', iostat=iovar) if (iovar /= 0) then write(6,'(a)') 'Warning, could not open file, probably invalid filename...' cycle end if exit end if else open(newunit=iunit,file=trim(fname),status='new', iostat=iovar) if (iovar /= 0) then write(6,'(a)') 'Warning, could not open file, probably invalid filename...' cycle end if exit end if end do return end subroutine openUnit subroutine readAndStoreAnalzers() ! This routine repetitively reads the gas anlyzers and stores their ! value in a user specified file. Reading stops only when the user ! hits the ESC key. ! 13-Oct-2018: removed CH4 instrument ! 24 Aug 10: Ver 2, changed elements of datevec for Ver 3.0 of main changes. ! 12 Sep 10: Ver 3.04, this calls readGasAnalyzersNC instead now. use CommParameters implicit none ! Local declarations integer iunit ! unit that is assigned by newunit integer readFreq ! Time between analyzer reads (sec). integer iport, dt(8), ifail, j, iread character fname*80, lineRead*80, longStr*113, key*1 real(8) dvec(11), tAdj logical sampleFeed, keyHit, fileExists, turnPumpOn, turnFeed2On integer, parameter:: onn = 1, off = 0 character name*6 integer name2seq ! Get the handle of the console fhandle = GetStdHandle(STD_OUTPUT_HANDLE) do ! allow the user to rerun this routine call openUnit (iunit, 'Enter name of file to store data: ') write(6,'(a)') 'Enter description for file header and end with a blank line' do write(6,'(a,$)') '> ' read(5,'(a)') lineRead if (lineRead == ' ') exit write(iunit,'(a)') '# '//lineRead end do write(iunit,'(a)') ' ' write(6,'(a,$)') 'Enter delay in seconds between sampling [5 sec]: ' read(5,'(a)') lineRead readFreq = 5 ! default value if (lineRead /= ' ') read(lineRead,*) readFreq write(6,'(a,$)') 'Run with sample-loop pump on (y/n)? [y]: ' read(5,'(a)') lineRead turnPumpOn = .true. ! use on as default if (scan(lineRead,'nN') /= 0) turnPumpOn = .false. write(6,'(a,$)') 'Purge protocal; Air [1], MC1 [2], MC2 [3], N2 [4] or for none: ' read(5,'(a)') lineRead name = 'none' ! This will not open or close any purge gas or change any flow rates. if (scan(lineRead,'1') /= 0) name = 'Air' if (scan(lineRead,'2') /= 0) name = 'MC1' if (scan(lineRead,'3') /= 0) name = 'MC2' if (scan(lineRead,'4') /= 0) name = 'N2' if (name2seq(name) /= 0) then Write(6,'(3a,i2)') 'Note, for ',trim(name),' use port: ', seqPorts(name2seq(name)) else write(*,'(a)') 'For calibrations gasses or N2 SL purge, use port 10' end if write(6,'(a,$)') 'Enter desired Valco port to sample and hit return to start sampling: ' read(5,*) iport call valcoControl(iport) dvec(2) = dble(iport) write(6,'(/,a)') '*** Hit ESC to stop sampling ***' ! Set time zero based on current time and date. call DATE_AND_TIME (values=dt) call julday(dt(1),dt(2),dt(3),dt(5),dt(6),real(dt(7)),tAdj,ifail) tAdj = tzero - tAdj write(iunit,'(a)') 'Variables = "Time (min)" "Flow (sccm)" "O2 (%)" "CO2(%)"' write(iunit,'(a)') 'Zone' ! main loop that reads analyzers, reports to screen and stores values if (turnPumpOn) call pumpOn () ! turn pump on first call purgeValve (name, onn) ! turns on purge gas if not sampling chemostats do call readAnalyzers ('Raw', dvec) ! Store and display values write(iunit,'(f8.2,1x,f6.1,3(1x,f8.4))') 1440.*(dvec(1)+tAdj), dvec(5), dvec(7), dvec(8) ! get the cursor position logstat = GetConsoleScreenBufferInfo(fhandle, conbuf) ! write current reading out at the same location longStr = '(''Run t:'',f6.1,,'' min'','' Port:'',i2,'' Flow: '',f6.1,'' O2:'',f6.2,'' CO2:'',f7.3,$)' write(6,longStr) real(1440.*(dvec(1)+tAdj)), int(dvec(2)), real(dvec(5)), (real(dvec(j)),j=7,8) ! put the cursor back to where it was logstat = SetConsoleCursorPosition(fhandle, conbuf.dwCursorPosition) ! Go to sleep call SLEEP (readFreq) ! See if key was hit keyHit = PEEKCHARQQ ( ) if (keyHit) then !See if key hit is ESC, if is so exit. key = GETCHARQQ( ) if (key == ESC) exit end if end do call pumpOff () !turn gas pump off call purgeValve (name, off) close(unit=iunit) write(6,'(/a,$)') 'Read and store data from a specified port again? (y/n): ' read(5,'(a)') lineread if (scan(lineRead,'nN') /= 0) exit end do return end subroutine readAndStoreAnalzers Subroutine readMassFlowMeter (flow) ! This routine read the mass flow meter ! Ver 2: 20 Mar 2010 ! Just improving communication ! Writes and reads to the 660B PS are terminated by CR/LF. use CommParameters implicit none real flow ! Local declarations integer, parameter:: maxTime = 1 ! maximum time to wait for a response (sec). integer, parameter:: maxAtmp = 5 ! maximum attempts to read the device. real tstart, tend integer iresult, ok2read, byteCnt, byteCntP, i character char3*3, dataStr*1024 flow = badRead do i=1,maxAtmp ! Command R5 requests the value of the flow. ! The responce looks like ! P##.### where the decimal place depends on the setting. ! It appears to also take about 0.1-0.2 sec to obtain a response. iresult = SPORT_WRITE_LINE (mfmPort, 'R5', 0) call cpu_time(tstart) tend = tstart do while (tend-tstart <= maxTime) iresult = SPORT_PEEK_LINE (mfmPort, ok2read, byteCntP) if (ok2read) exit call cpu_time(tend) end do if (.not. ok2read) cycle ! data not in buffer, try again. iresult = SPORT_READ_LINE (mfmPort, dataStr, byteCnt) if (verify(dataStr(2:8),okDigits) /= 0 .OR. len_trim(dataStr(2:8)) == 0) cycle ! Bad read read(dataStr(2:8),*) flow !write(100,'(f8.4,1x,i2,1x,f5.3,1x,i4,1x,a)') flow, i, tend-tstart, byteCntP, trim(dataStr) ! remove this exit end do return end Subroutine readMassFlowMeter subroutine readOxigraf(o2Ave, co2Ave) ! This routine reads the oxigraf detector for CO2 and O2 ! oxigraf communcation begins with an ESC and is terminated with a semicolon. ! Values that can be read are: ! 0: System status (16 bit output) ! 1: Oxygen concentration (0.01%) ! 2: Sample cell pressure (0.1 mBar) ! 3: Sampel cell temperature (0.01 C) ! 4: Sample flow rate (ml/min) ! 5: Time stamp counter (9.2 ms?) ! 6: Alarms (16 bit output) ! 7: CO2 concentration (0.01%) ! 8: CO2 cell pressure (0.1 mm Hg) ! 9: CO2 cell temperature (0.01 C) ! Ver 2: 19 Mar 2010 ! Improving communication and averaging outputs. ! The responce from any command sent to the oxigraf is: ! C:##### ! Where C is the command sent, #### is any data requested by command ! and and are the carrage return and line feed (two characters). ! Hence, use CommParameters real o2Ave, co2Ave ! Local declaratiosn integer, parameter:: aveReads = 10 ! The number of reads to average together integer, parameter:: maxTime = 1 ! maximum time to wait for a response (sec). integer i, ok2read ,byteCnt, byteCntP, iresult, nPts, lenStr real tstart, tend, o2, co2 character dataStr*100 nPts = 0 do i=1,aveReads ! Get O2, CO2, Cell prssure, and flowrate. !call purgePorts () iresult = SPORT_WRITE_DATA (oxigrafPort, ESC//'R1,7;', 0) call cpu_time(tstart) tend = tstart do while (tend-tstart <= maxTime) iresult = SPORT_PEEK_LINE (oxigrafPort, ok2read ,byteCntP) if (ok2read) exit call cpu_time(tend) end do if (.not. ok2read) cycle ! data not in buffer, try again. iresult = SPORT_READ_LINE (oxigrafPort, dataStr, byteCnt) lenStr = len_trim(dataStr) if (dataStr(1:2) == 'R:' .and. dataStr(lenStr-1:lenStr) == crlf) then ! well formed response read(dataStr(3:lenStr-2),*) o2, co2 o2 = o2/100.0 co2 = co2/100.00 !write(100,'(2(f8.4,1x),i2,1x,f5.3,1x,i4,1x,a)') o2, co2, i, tend-tstart, byteCntP, trim(dataStr) ! remove this else ! error reading line cycle end if nPts = nPts + 1 if (nPts == 1) then ! ch4Ave must be initialized o2Ave = o2 co2Ave = co2 cycle end if o2Ave = o2Ave + ( o2 - o2Ave)/real(nPts) ! running average. co2Ave = co2Ave + (co2 - co2Ave)/real(nPts) ! running average. end do if (nPts == 0) then o2Ave = badRead co2Ave = badRead end if ! write(100,'(2(f8.4,1x),I4)') o2Ave, co2Ave, nPts ! remove this return end subroutine readOxigraf Subroutine valcoControl(portNo) ! This routine changes the port number of the valco valvue ! Ver 2: 20 Mar 2010 ! Updating serial port read protocal. ! The Valco uses only to end commands and responces use CommParameters implicit none integer portNo ! Local declarations integer, parameter:: maxTime = 5 ! maximum time to wait for a response (sec). ! It takes about 2.5 sec to rotate 1/2 way around valve. integer, parameter:: maxAtmp = 5 ! maximum attempts to read the device. real tstart, tend integer iresult, ok2read, byteCnt, portAt, i character char4*4, dataStr*1024 portAt = badRead do i=1,maxAtmp ! Goto port portNo char4 = 'GO' write(char4(3:4),'(i2)') portNo ! Go to specified port number. iresult = SPORT_WRITE_LINE (valcoPort, char4, 0) ! Note, an error will be return, such as: ! GO 3 = Bad command ! if port is already on port 3., so this needs to be flushed from ! the buffer. ! Read port number iresult = SPORT_WRITE_LINE (valcoPort, 'CP', 0) call cpu_time(tstart) tend = tstart do while (tend-tstart <= maxTime) ! It appears the CP command reponse does not occur until valve ! is at its final destination, so this makes the program wait ! unitl the valve has stopped moving, unless maxTime is exceeded. iresult = SPORT_PEEK_LINE (valcoPort, ok2read ,byteCnt) if (ok2read) exit call cpu_time(tend) end do if (.not. ok2read) cycle ! No data in buffer, try again. do while (ok2read) ! This will continue to read records until buffer is empty ! Only the last record in the buffer is used below. iresult = SPORT_READ_LINE (valcoPort, dataStr, byteCnt) iresult = SPORT_PEEK_LINE (valcoPort, ok2read ,byteCnt) end do !write(6,'(a,f5.3)') 'Wait time: ', tend-tstart !write(6,'(a,i1,a)') 'i=',i,' dataStr: '//trim(dataStr)//'END' if (dataStr(1:15) == 'Position is = ' .AND. scan(dataStr(16:17),'0123456789') /= 0) read(dataStr(16:17),*) portAt if (portAt == portNo) exit end do portNo = portAt return end subroutine valcoControl subroutine setupWTAIN () ! This routine setups up the mode and decimal position for the WTAIN board use CommParameters implicit none integer i character str*4, iostring*1024 ! First set the mode do i=1,4 str = WTAIN//'M'//char(i+64)//mode call writeWT(WTAINport, str) call readWT(WTAINport, iostring) ! should just echo same value if (iostring /= str) write(6,'(a)') 'Error reading WTAIN board during setup, value = '//trim(iostring) end do ! next set the decimal do i=1,4 str = WTAIN//'D'//char(i+64)//dec call writeWT(WTAINport, str) call readWT (WTAINport, iostring) ! should just echo same value if (iostring /= str) write(6,'(a)') 'Error reading WTAIN board during setup, value = '//trim(iostring) end do return end subroutine setupWTAIN Subroutine readWT(port, outStr) ! This routine reads outStr from a Weeder Tech module. ! Notes: ! You must prefix a command with the header character as set by the dipswitch on the board ! All command must be terminated by a character. Likewise, all data returned is terminated with ! If a command does not return a value, then it appears to echo the command. Consequently, all input ! have some kind of output. ! Spaces are not allowed. ! Example input: AVB !this reads voltage for channel B on board with address A for the WTDAC board ! Example responce to above: AVB#### (for WTDAC board) ! By specifing SPORT_CONNECT and using LINE reads and write, the character can be easily handled. use CommParameters implicit none integer port ! The serial port the WT board is connected to character outStr*(*) ! input command string, and output of responce if requrested ! Local declarations integer, parameter:: maxTime = 1 ! maximum time to wait for a response (sec). integer, parameter:: maxAtmp = 5 ! maximum attempts to read the device. real tstart, tend integer iresult, ok2read, byteCnt, i character char4*4 outStr = '?' ! set to ? in case read fails. do i=1,maxAtmp ! Read a module, but allow maxTime seconds for response to be place in buffer. call cpu_time(tstart) tend = tstart do while (tend-tstart <= maxTime) iresult = SPORT_PEEK_LINE (port, ok2read ,byteCnt) if (ok2read==1) exit call cpu_time(tend) end do if (ok2read==0) cycle ! No data in buffer, try again. do while (ok2read==1) ! This will continue to read records until buffer is empty ! Only the last record in the buffer is used below. iresult = SPORT_READ_LINE (port, outStr, byteCnt) iresult = SPORT_PEEK_LINE (port, ok2read ,byteCnt) end do exit end do return end subroutine readWT Subroutine writeWT(port, inStr) ! This routine write inStr to a Weeder Tech module. ! Only the last record in the buffer is returned. use CommParameters implicit none integer port character inStr*(*) ! input command string ! Local declarations integer iresult iresult = SPORT_WRITE_LINE (port, trim(inStr), 0) if (iresult /= 0) write(6,'(a,i2,a,a)') 'WARNING writing to WT board on port: ', port, ' with string: ', trim(inStr) return end subroutine writeWT subroutine Wayjun(chan, mA) ! This routine reads the Wayjun Analong isolator and converts the voltage back to current. use CommParameters, only: WTAINport implicit none character*(*), intent(in) :: chan ! string to read WTAIN board channel real(8), intent(out):: mA ! Current output of the probe (mA). ! Local declarations character iostring*1024 call writeWT(WTAINport, chan) call readWT (WTAINport, iostring) ! should return voltage in mV in the string if (scan(iostring,'?') /= 0) then mA = 0. return end if ! The Wayjun Analog Signal Isolators converts 0-20 mA input to 0-10 V output, so convert it back read(iostring(2:),*) mA ! note, first character is the channel letter mA = 2.0*mA/1000.0 ! convert to mA return end subroutine Wayjun subroutine readpH(chan, pH) ! This routine reads the pH probes use CommParameters implicit none character*(*) chan ! string to read WTAIN board channel real(8) pH ! value of probe ! local declarations integer i integer, parameter:: nTries = 3 ! number of attempts to get a pH value real(8) mA pHerror = 'pH!' pH = -1.0 ! this is the error value used of pH was not read correctly do i = 1,nTries call Wayjun(chan, mA) ! Read current of probe ! If mA is less than 4, then this is an error indication from the device, or read error if (mA < 4.0 .or. mA > 20.0) cycle ! Convert 4-20 mA signal to pH based on Hamilton settings pHerror = '' pH = ((pH20 - pH4)*mA + (20.0*pH4 - 4.0*pH20))/(20.0 - 4.0) exit end do return end subroutine readpH subroutine readDO(chan, O2) ! This routine reads the DO probes use CommParameters implicit none character*(*) chan ! string to read WTAIN board channel real(8) O2 ! value of probe ! local declarations integer i integer, parameter:: nTries = 3 ! number of attempts to get a pH value real(8) mA DOerror = 'DO!' O2 = -1.0 ! This is the error value for DO do i=1,nTries call Wayjun(chan, mA) ! Read current of probe ! If mA is less than 4, then this is an error indication from the device, or read error if (mA < 4.0 .or. mA > 20.0) cycle DOerror = '' O2 = ((DO20 - DO4)*mA + (20.0*DO4 - 4.0*DO20))/(20.0 - 4.0) ! convert from mg/L to microM O2 = 1000.D0*O2/32.0d0 exit end do return end subroutine readDO subroutine pumpOn () ! This routine turns the gas pump for the gas sampling loop on ! and also turns on the N2 used for the nafion dryer use CommParameters implicit none integer ierr character outStr*80 ! write to the WTDOT board ! First turn N2 gas on call writeWT(WTDOTport, N2DryOn) ! get responce, which would just be the return of command call readWT(WTDOTport, outStr) if (outStr /= N2DryOn) then write(6,*) 'WARNING:: error turning N2 On' write(6,'(2a)') ' WTDOT Output response was: ',trim(outStr) end if call writeWT(WTDOTport, gasPumpOn) ! get responce, which would just be the return of command call readWT(WTDOTport, outStr) if (outStr /= gasPumpOn) then write(6,*) 'WARNING:: error on gas pump On' write(6,'(2a)') ' WTDOT Output response was: ',trim(outStr) end if return end subroutine pumpOn subroutine pumpOff () ! This routine turns the gas pump for the gas sampling loop off ! and turns the N2 off for the nafion dryer use CommParameters implicit none character outStr*80 ! write to the WTDOT board ! Turn gas pump off call writeWT(WTDOTport, gasPumpOff) ! get responce, which would just be call readWT(WTDOTport, outStr) if (outStr /= gasPumpOff) then write(6,*) 'WARNING:: error on gas pump Off' write(6,'(2a)') ' WTDOT Output response was: ',trim(outStr) end if ! Turn N2 gas off call writeWT(WTDOTport, N2DryOff) ! get responce, which would just be the return of command call readWT(WTDOTport, outStr) if (outStr /= N2DryOff) then write(6,*) 'WARNING:: error turning N2 Off' write(6,'(2a)') ' WTDOT Output response was: ',trim(outStr) end if return end subroutine pumpOff subroutine get647Cparams () ! Get the flow ranges for each MFC ! Number returned requires table lookup values (see globalVars module). use CommParameters implicit none integer i, j, iValue character iostring*8000, wStr*20 wStr = 'RA c R' do i=1, noMFC write(wStr(4:4),'(i1)') i call write647C(trim(wStr)) call read647c(iostring) if ( scan(iostring,'E') /= 0) then write(6,*) 'Error getting MKS 647C flow ranges, value = '//trim(iostring) write(6,*) 'Fix communiction problem and restart program or retry' return end if read(iostring,*) iValue if (iValue > 9) then write(6,*) 'Error reading MKS flow ranges, conversion factors may be incorrect.' return end if MFCranges(i) = MFCrangeValues(iValue+1) end do ! Get the gas correction factors, These are reported as % values. wStr = 'GC c R' do i=1, noMFC write(wStr(4:4),'(i1)') i call write647C(trim(wStr)) call read647c(iostring) if ( scan(iostring,'E') /= 0) then write(6,*) 'Error getting gas correction factor, value = '//trim(iostring) write(6,*) 'Fix problem and restart program or retry' return end if read(iostring,*) iValue MFCgcf(i) = real(iValue)/100.0 end do return end subroutine get647Cparams subroutine changeSetpoint () ! This routine is used to change an MFC set point interactively use CommParameters implicit none character ioStr*8000, iStr*11 integer gasMenu, MFC, iValue real(4) setPoint, rValue real(8) fR1, fR2 ! Get 647c parameters write(6,*) 'Getting 647c run parameters...' call get647Cparams () ! First find out which gas menu is running call write647c('GM R') call read647c(ioStr) if (scan(ioStr,'E') /= 0 ) then write(6,'(a)') 'Error getting MFC gas menu, returning...' return end if read(ioStr,*) gasMenu if (gasMenu < 0 .or. gasMenu >5) then write(6,'(a)') 'Erroneous gas menu read. Returning (try again)...' return end if write(6,'(a,$)') 'Which MFC channel do you want to change SP for [1-8]: ' read(5,*) MFC if (gasMenu == 0) then ! 647c is in menu X mode ! FS c xxxx ! c = 1..8 channel ! x = 0..1100 setpoint in 0.1 percent of full scale ! write(6,'(a)') 'Note, gas menu X running' write(*,'(a)') ' **** Warning, this gas menu is NOT compatible with current program!!' ! First get current value: iStr = 'FS c R' write(iStr(4:4),'(i1)') MFC call write647c(iStr) call read647c(ioStr) if (scan(ioStr,'E') /= 0 ) then write(6,'(a)') ' *** Error getting MFC set point, returning...' return end if read(ioStr,*) iValue ! this value is 0.1% of full scale, which depends on GFC also rValue = real(iValue)*MFCranges(MFC)*MFCgcf(MFC)/1000. ! Now set it to user requested value write(6,'(3(a,f7.2),a,$)') 'SP currently: ',rValue,' change to [', & & MFCranges(MFC)*MFCgcf(MFC)*0.01,'-',MFCranges(MFC)*MFCgcf(MFC)*1.10,' sccm]: ' read(5,*) setPoint iValue = nint( 1000.*setPoint/(MFCranges(MFC)*MFCgcf(MFC)) ) write(iStr(6:9),'(i4.4)') iValue call write647c(iStr) call read647c(ioStr) ! flush from buffer ! Now check it iStr(6:9) = 'R ' call write647c(iStr) call read647c(ioStr) if (scan(ioStr,'E') /= 0 ) then write(6,'(a)') ' *** Error setting MFC set point, returning...' return end if read(ioStr,*) iValue write(6,'(a,i1,a,f8.2,a)') 'MFC ',MFC,' Set to: ',real(iValue)*MFCranges(MFC)*MFCgcf(MFC)/1000., ' (sccm)' ! NOTE, in theory if the flow to the algae is changed, then the air+co2 feed should change, but that routine ! assumes that gas menu 1-5 are being used (see below). else ! a gas menu is being used ! GP c s xxxx ! c = 1..8 MFC channel ! s = 1..5 gas set 1 to 5 ! x = 0..1100 setpoint in 0.1 percent of full scale ! write(6,'(a,i1,a)') 'Note, gas menu ',gasMenu,' running' ! First get current value: iStr = 'GP c s R' write(iStr(4:4),'(i1)') MFC write(iStr(6:6),'(i1)') gasMenu call write647c(iStr) call read647c(ioStr) if (scan(ioStr,'E') /= 0 ) then write(6,'(a)') ' *** Error getting MFC set point, returning...' return end if read(ioStr,*) iValue ! this value is 0.1% of full scale, which depends on GFC also rValue = real(iValue)*MFCranges(MFC)*MFCgcf(MFC)/1000. ! Now set it to user requested value write(6,'(3(a,f7.2),a,$)') 'SP currently: ',rValue,' change to [', & & MFCranges(MFC)*MFCgcf(MFC)*0.01,'-',MFCranges(MFC)*MFCgcf(MFC)*1.10,' sccm]: ' read(5,*) setPoint iValue = nint( 1000.*setPoint/(MFCranges(MFC)*MFCgcf(MFC)) ) write(iStr(8:11),'(i4.4)') iValue call write647c(iStr) call read647c(ioStr) ! flush from buffer ! Now check it iStr(8:11) = 'R ' call write647c(iStr) call read647c(ioStr) if (scan(ioStr,'E') /= 0 ) then write(6,'(a)') ' *** Error setting MFC set point, returning...' return end if read(ioStr,*) iValue write(6,'(a,i1,a,f8.2,a)') 'MFC ',MFC,' Set to: ',real(iValue)*MFCranges(MFC)*MFCgcf(MFC)/1000., ' (sccm)' ! If the gas flow to the reactors has been changed, then the air flow must also be increased ! No longer using the air reservour !if (MFC == mfcMC1 .or. MFC == mfcMC2) then ! call getGasFlow (mfcMC1, fR1) ! Get current flow rate to MC1 ! call getGasFlow (mfcMC2, fR2) ! MC2 ! write(6,'(a)') 'Also changing air feed appropriately' ! call changeAirSupply ((fR1+fR2)*airSup + airAdd) !end if end if return end subroutine changeSetpoint subroutine changeAirSupply (airFlow) ! this routine changes the flow of air to match demand. ! The supply of air is set to airSup*(gasFlow(mfcMC1)+gasFlow(mfcMC2)), that is the flow to the all reactors ! If the air purge is ON, then this flow is increased by adding airPur value. ! This routine assumes: ! That a gas menu 1-5 is running, so does not bother to check if menu X is being used (See changeSetpoint) ! The MFC is on (this does not set it on) ! ***** note, this routine could be replaced by changeMFCsp ******* use CommParameters implicit none real(8) airFlow ! Flow rate that Air should be changed to (sccm or mL/min) ! local declarations character iStr*11, ioStr*8000 integer iValue ! MKS 647c Command of interest here ! GP c s xxxx ! c = 1..8 MFC channel ! s = 1..5 gas set 1 to 5 ! x = 0..1100 setpoint in 0.1 percent of full scale ! iStr = 'GP c s ####' write(iStr(4:4),'(i1)') mfcAir write(iStr(6:6),'(i1)') useGasMenu iValue = nint( 1000.*airFlow/(MFCranges(mfcAir)*MFCgcf(mfcAir)) ) write(iStr(8:11),'(i4.4)') iValue call write647c(iStr) call read647c(ioStr) ! flush from buffer, but also check for errors if (scan(ioStr,'E') /= 0 ) write(6,'(a)') ' *** Error setting MFC set point for Air ***' return end subroutine changeAirSupply subroutine changeMFCsp (nMFC, flowSP) ! this routine changes the set point for a MFC. ! This routine assumes: ! that a gas menu 1-5 is running, so does not bother to check if menu X is being used (See changeSetpoint) ! The MFC is on (this does not set it on) use CommParameters implicit none integer nMFC ! the MFC to change real(8) flowSP ! desired flow rate set point (sccm or mL/min) ! local declarations character iStr*11, ioStr*8000 integer iValue ! MKS 647c Command of interest here ! GP c s xxxx ! c = 1..8 MFC channel ! s = 1..5 gas set 1 to 5 ! x = 0..1100 setpoint in 0.1 percent of full scale ! iStr = 'GP c s ####' write(iStr(4:4),'(i1)') nMFC write(iStr(6:6),'(i1)') useGasMenu iValue = nint( 1000.*flowSP/(MFCranges(nMFC)*MFCgcf(nMFC)) ) ! convert to what the 647c uses write(iStr(8:11),'(i4.4)') iValue call write647c(iStr) call read647c(ioStr) ! flush from buffer, but also check for errors if (scan(ioStr,'E') /= 0 ) write(6,'(a,i1,a)') ' *** Error setting set point for #',nMFC,' MFC ***' return end subroutine changeMFCsp Subroutine read647c(outStr) ! This routine reads outStr to the 647C MFC controller. ! ANY call to write647c MUST be followed by a call to this routine to remove the that is ! returned even if no string is being returned. ALSO, the port must be connected using: ! iresult = SPORT_CONNECT (mfcPort, (DL_OUT_CR .or. DL_OUT_LF .or. DL_TERM_CRLF)) ! That is, don't strip the from the string on return by adding DL_TOSS_CR or DL_TOSS_LF, instead it is manually removed below. ! For some reason, if there is only in the buffer, then SPORT_PEEK_LINE will not report ! any bites, but the will remain in the buffer, which messes up subsequent reads. use CommParameters !, only: mfcPort use ifport implicit none character outStr*(*) ! input command string, and output of responce if requrested ! Local declarations real(8), parameter:: maxTime = 5.0d0 ! maximum time to wait for a response (sec). real(8) tstart, tend, t0 integer(8) cnt, cnt_rate, cnt_max ! integer(8) clock won't turn over for > 290,000 years !! integer iresult, ok2read, byteCnt, i, ioerr character char4*4 outStr = 'E' ! the 647c returns E# if an error occurs, so this is set if the read fails. ! Read the 647C, but allow maxTime seconds for response to be place in buffer. call SYSTEM_CLOCK(cnt, cnt_rate, cnt_max); tstart = dble(cnt)/dble(cnt_rate) tend = tstart do while (tend-tstart <= maxTime) iresult = SPORT_PEEK_LINE (mfcPort, ok2read ,byteCnt) if (ok2read==1) exit call SYSTEM_CLOCK(cnt, cnt_rate, cnt_max); tend = dble(cnt)/dble(cnt_rate) end do if (ok2read==0) return ! No data in buffer within maxTime seconds, so return. ! Read buffer iresult = SPORT_READ_LINE (mfcPort, outStr, byteCnt) outStr = outStr(1:len_trim(outStr)-2) ! removes characters at end of string. return end subroutine read647c Subroutine write647c(inStr) ! This routine write inStr to the 647C MFC controller. use CommParameters, only: mfcPort use ifport implicit none character inStr*(*) ! input command string ! Local declarations integer iresult iresult = SPORT_WRITE_LINE (mfcPort, trim(inStr), 0) return end subroutine write647c subroutine selectGasMenu (gasMenuSet) ! This routine allows user to set the gas menu implicit none integer gasMenuSet ! menu value 1-5, or 0 for x-menu to be set !local declarations character ioStr*8000, iStr*11, menu*4 integer gasMenu, MFC, iValue ! First find out which gas menu is running call write647c('GM R') call read647c(ioStr) if (scan(ioStr,'E') /= 0 ) then write(6,'(a)') 'Error getting MFC gas menu, returning...' return end if read(ioStr,*) gasMenu if (gasMenu == gasMenuSet) return !already running the requested menu write(6,'(a,i1,a,i1)') 'WARNING, changing 647c gas menu from ',gasMenu,' to ', gasMenuSet write(6,'(a)') 'Flow controller set points will likely change!' menu = 'GM #' write(menu(4:4),'(i1)') gasMenuSet call write647c(menu) call read647c(ioStr) ! flush from buffer ! Check to see if correct call write647c('GM R') call read647c(ioStr) if (scan(ioStr,'E') /= 0 ) then write(6,'(a)') 'Error getting MFC gas menu on confirmation check, returning...' return end if read(ioStr,*) gasMenu if (gasMenu /= gasMenuSet) write(6,'(a)') 'WARNING: Gas menu not set as requested. Returning' return end subroutine selectGasMenu subroutine getGasFlow (nMFC, flow) ! Read the flow rate of the specified MFC ! Note, call to get647Cparams should be called before this routine is called use ifport use CommParameters, only: MFCranges, MFCgcf implicit none integer nMFC ! the MFC to read real(8) flow ! local declarations integer i, j, iValue character iostring*8000, wStr*20 wStr = 'FL #' write(wStr(4:4),'(i1)') nMFC call write647C(trim(wStr)) call read647c(iostring) if ( scan(iostring,'E') /= 0) then write(6,'(a)') 'Error getting 647C flow, value = '//trim(iostring) flow = -99.99 return end if if ( trim(iostring) == '-----' ) then ! assume value is off scale. flow = -99.99 else read(iostring,*) iValue flow = MFCranges(nMFC)*MFCgcf(nMFC)*dble(iValue)/1000. ! flow is in SCCM end if return end subroutine getGasFlow subroutine getGasFlowSP (nMFC, flowSP) ! Read the flow set point of the specified MFC ! Note, call to get647Cparams should be called before this routine is called ! Also, this routine assumes ! - 647c is running gas menu 1-5 (NOT X or 0) use ifport use CommParameters, only: MFCranges, MFCgcf, useGasMenu implicit none integer nMFC ! the MFC to read real(8) flowSP ! flow set point of MFC ! local declarations integer iValue character ioStr*8000, iStr*11 ! MKS 647c Command of interest here ! GP c s xxxx ! c = 1..8 MFC channel ! s = 1..5 gas set 1 to 5 ! x = 0..1100 setpoint in 0.1 percent of full scale ! iStr = 'GP c s R' write(iStr(4:4),'(i1)') nMFC write(iStr(6:6),'(i1)') useGasMenu call write647c(iStr) call read647c(ioStr) if (scan(ioStr,'E') /= 0 ) then write(6,'(a)') ' *** Error getting MFC set point, returning...' return end if read(ioStr,*) iValue ! this value is 0.1% of full scale, which depends on GFC also flowSP = real(iValue)*MFCranges(nMFC)*MFCgcf(nMFC)/1000. return end subroutine getGasFlowSP integer function name2seq (name) ! Returns the location in the sequence given a name use CommParameters implicit none character*(*) name ! local declarations integer i name2seq = 0 ! indicates name not found in seqNames do i=1,noSeq if (seqNames(i) /= name) cycle ! name not here name2seq = i exit end do return end function subroutine monitorMFC () ! Monitors all the MFC connected to the MKS 647c use CommParameters, Only: noMFC, ESC, MFCranges, MFCgcf use ifcore implicit none ! local declarations character iostring*8000, wStr*20, longStr*113, key*1 integer i, j, iValue, dt(8), k, iresult, cntrl, loopWait real(4) MFCflows(noMFC), rValue, lineCnt logical keyHit ! Get 647c parameters write(6,*) 'Getting 647c run parameters...' call get647Cparams () loopWait = 5 ! number of seconds to wait between querering 647c lineCnt = 35 monitor: do if (lineCnt >= 35) then CALL DATE_AND_TIME (values=dt) write(6,'(a)') ' *** MC Sampling STOPPED. Hit ESC to return to sampling ***' write(6,'(1x,2(i2.2,a),i4,4x,a)') dt(2),'/',dt(3),'/',dt(1),'MFC 1 MFC 2 MFC 3 MFC 4 MFC 5 MFC 6 MFC 7 MFC 8' lineCnt = 1 end if ! See if ESC key was hit keyHit = PEEKCHARQQ ( ) if (keyHit) then !See if key hit is ESC, if is so exit. key = GETCHARQQ( ) if (key == ESC) exit monitor end if ! Get the flow values wStr = 'FL #' do i=1, noMFC write(wStr(4:4),'(i1)') i call write647C(trim(wStr)) call read647c(iostring) if ( scan(iostring,'E') /= 0) then write(6,'(a)') 'Error getting flow flows, value = '//trim(iostring) MFCflows(i) = -99.99 cycle end if if ( trim(iostring) == '-----' ) then ! assume value is off scale. MFCflows(i) = -99.99 else read(iostring,*) iValue MFCflows(i) = MFCranges(i)*MFCgcf(i)*real(iValue)/1000. end if end do CALL DATE_AND_TIME (values=dt) longStr = '(''At: '',2(i2.2,'':''),i2.2,8(1x,f7.2))' write(6,longStr) (dt(4+j),j=1,3), (MFCflows(j),j=1,noMFC) lineCnt = lineCnt + 1 ! put the cursor back to where it was !logstat = SetConsoleCursorPosition(fhandle, conbuf.dwCursorPosition) call sleep(loopWait) end do monitor return end subroutine monitorMFC subroutine MFCsOnOff () ! This routine is used to turn MFCs on or off use CommParameters, Only: noMFC implicit none character MFCstr*80, MFCi*4, MainValveState*7, junk*10 integer i, nMFCset, MFCs(9) ! Turn MFC's on Note, 0 corresponds to main valve. It must be on ! for any flow to occur. write(6,'(a)') 'Enter MFC numbers to turn ON. Note, "0" corresponds to main valve,' write(6,'(a,$)') 'which must be on for any flow. Enter MFCs (hit return for none): ' read(5,'(a)') MFCstr MFCi = 'ON #' nMFCset = 0 MainValveState = 'Unchanged' ! There is not command to assess the state of the Main Valve do i=0,noMFC if (scan(trim(MFCstr),char(48+i)) /= 0) then ! Turn MFC i on write(MFCi(4:4),'(i1)') i call write647c(MFCi) call read647c(junk) ! flush from buffer nMFCset = nMFCset + 1 MFCs(nMFCset) = i if (i == 0) MainValveState = 'ON' end if end do if (nMFCset > 0) then write(6,'(/a,9(1x,i1))') 'MFCs set to ON:', (MFCs(i),i=1,nMFCset) else write(6,'(/a)') 'No MFCs changed to ON' end if ! Turn MFC's OFF Note, 0 corresponds to main valve. If turned off, no flow occurs write(6,'(/,a)') 'Enter MFC numbers to turn OFF. Note, "0" corresponds to main valve.' write(6,'(a,$)') 'If set, all flows turned off. Enter MFCs (hit return for none): ' read(5,'(a)') MFCstr MFCi = 'OF #' nMFCset = 0 do i=0,8 if (scan(trim(MFCstr),char(48+i)) /= 0) then ! Turn MFC i off write(MFCi(4:4),'(i1)') i call write647c(MFCi) call read647c(junk) ! flush from buffer nMFCset = nMFCset + 1 MFCs(nMFCset) = i if (i == 0) MainValveState = 'OFF' end if end do if (nMFCset > 0) then write(6,'(/a,9(1x,i1))') 'MFCs set to OFF:', (MFCs(i),i=1,nMFCset) else write(6,'(/a)') 'No MFCs changed to OFF' end if write(6,'(/,a)') 'Note, state of Main Valve: '//trim(MainValveState) return end subroutine MFCsOnOff