! 13 Jan 2015 Ver 1.0: First attempt at developing hardware monitor and ! controller for A2M project. This is based on MonitorGases_4.03.f90 ! as a starting point. ! Note, in any new major changes, port sequence is a better global ! variable to key on, because the same port can be connected to ! different gases. ! 22 May 2015 Ver 1.05. Added shell to export images ! 26 May 2015 Ver 1.06. Added additional io handling to try and fix 647c reads. ! Made some other minor changes. ! 16 Jul 2015 Ver 1.07. Need to read 647c parameters each time the 647c is invoked ! 22 Sep 2015 Ver 1.10. Account for CO2 enrichment of air that was begun some time ago. Also fixed the com problem ! ! Future Additions to consider ! - add both co2Adj_L and co2Adj_H. For now, just use co2Adj based on CO2 enrichment, but co2Adj_L could ! be determined from N2 purge. However, this ould cause the output file to be changed, so do for next experiment. 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 !===================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. 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 WTAIN commands. These are based on which channel the WTAIN board is set to ! and what channels instruments/valves are connected to. character(len=1), parameter:: WTAIN = 'A' ! The WTAIN board that the pH and DO probes are connected to character(len=3), parameter:: pHAlg = WTAIN//'RA' ! Read channel A on board (pH of Algae) character(len=3), parameter:: DOAlg = WTAIN//'RB' ! Read channel B on board (DO of Algae) character(len=3), parameter:: pHDig = WTAIN//'RC' ! Read channel C on board (pH of Digestor) character(len=3), parameter:: DODig = WTAIN//'RD' ! Read channel D on board (DO of Digestor) 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 = 5 ! 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_Alg, co2Feed_Alg ! Concentrations of feed gas for algae real ch4Mix ! concentration (%) of CH4 in mix gas used to measure CH4 analyzer offset real co2Adj, o2Adj, ch4Adj_L, ch4Adj_H ! Offsets between calibrations. Only CH4 has two 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_CH4, SL_o2_new, SL_co2_new, SL_ch4_new ! concentrations of these gases in the sample loop. integer, parameter:: nOC = 12 real(8) ocVec(nOC) ! data stored in the OC file. See getOC subroutine integer, parameter:: nData = 12 real(8) dataVec(nData) ! first 12 columns in the *.dat file. also see getOC routine real(8) dataMat(noSeq,11) integer portAlg, portDig ! Valco ports algae and digestor are on. integer portCH4, portN2, portAir ! Valco ports top sample gases integer mfcAlg, mfcDig, mfcCH4, mfcN2 ! the MKS 647C controllers of the algae, digestor CH4 and N2 integer mfcAir, mfcCO2 ! the MKS 647C controllers for mixing air with CO2. Note, CO2 should be setup as slave to air MFC. integer useGasMenu ! this is the gas menu that the MKS 647c controller will be set to for the experiment, usually 1 real(8) airMixSup ! the air and CO2 mix needs to be this fraction higher that the gas flow to the algal reactor (unitless) real(8) airMixPur ! This is the absolute increase to the air-co2 mixture when purging the sample loop (mL/min) 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 ! reactor exchange flow rate (mL/min) real(8) PAR ! light level for algal reactor (uE/m2/s) real(8) MCrpm(noSeq) ! RPMs of algal and digestor reactors namelist /recovery/ o2Feed_Alg, co2Feed_Alg, ch4Mix namelist /recovery/ seqPurgeTime, loopTime namelist /recovery/ tzero, noteCnt, MCheadSpaceVol, MCliqVol, SLvol namelist /recovery/ airMixSup, airMixPur namelist /recovery/ portAlg, portDig, portCH4, portN2, portAir namelist /recovery/ version namelist /recovery/ pH4, pH20, DO4, DO20 namelist /recovery/ mfcAlg, mfcDig, mfcCH4, mfcN2, mfcAir, mfcCO2, useGasMenu namelist /recovery/ tempC, flowEx, PAR namelist /recovery/ MCrpm namelist /recovery/ seqPorts, seqMCs, seqNames ! 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 MonitorGasesA2M ! This Program is used to monitor the gas composition for the bioreactor A2M setup. 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.10 (22 Sep 2015)' ! Parameters that are hardward dependent and unlikely to change during a run ! This are all saved in the recovery file too. portAlg =1; portDig = 2; portCH4 = 10; portN2 = 10; portAir = 10 ! Valco port numbers for the MCs and gases mfcAlg = 1; mfcDig = 2; mfcCH4 = 7; mfcN2 = 8 ! The 647C mass flow controllers that feed the algae and digestor reactors, and CH4 and N2 mixture mfcAir = 5; mfcCO2 = 6 ! These are used to mix CO2 with air. The MFC for CO2 must be set as slave to air MFC. useGasMenu = 1 ! this is the gas menu that the MKS 647c controller will be set to for the experiment, usually 1 airMixSup = 1.25 ! the air and CO2 mix needs to be this fraction higher that the gas flow to the algal reactor airMixPur = 500.0 ! This is the absolute increase to the air-co2 mixture when purging the sample loop (mL/min) SLvol = 0.190 ! sample loop volume (L) 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) = (/portCH4 , portAir, portAlg, portN2 , portDig/) seqNames(1:noSeq) = (/'CH4mix', 'Air' , 'Algae', 'N2' , 'Dig' /) ! Names of ports in seqPorts seqMCs(1:noSeq) = (/0 , 0 , 1 , 0 , 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 MonitorA2M 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) inquire(file=trim(filename)//'.dat' ,exist=datExists) inquire(file=trim(filename)//'.rcv' ,exist=rcvExists) inquire(file=trim(filename)//'.oc' ,exist= ocExists) !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; ch4Adj_L = 0.0; ch4Adj_H = 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" "CH4 offset L" "CH4 offset H"' longStr = ' "Time ## (d)" "Port ##" "Liq Vol ##" "Gas Vol ##" "SL Flow ## (sccm)" "Gas Flow ## (sccm)" "O2 ## (%)" "CO2 ## (%)"& & "CH4 ## (%)" "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(123:124) = ptN ! CH4 Concentration (%) longStr(135:136) = ptN ! pH longStr(143:144) = 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" "Exchange Rate" "Light" "Algae RPM" "Dig 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; ch4Adj_L = 0.0; ch4Adj_H = 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 and CH4 offsets SL_o2 = SL_o2_new; SL_co2 = SL_co2_new; SL_ch4 = SL_ch4_new ! update gas composition in sample loop longStr = '(2(i2.2,''/''),i2,1x,2(i2.2,'':''),i2.2,1x,a8,##x,f4.0,3x,f4.1,3x,f5.2,3x,f4.2,3x,f5.2,3x,f6.2)' write(longStr(43:44),'(i2)') i ip = 9 if (seqMCs(i)==1) ip = 11 ! print out the DO and pH values too for bioreactors. if (i==1) write(6,'(a)') ' Date Time Gas/MC Flow O2(%) CO2(%) CH4(%) 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) 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 ! turn valves for CH4 and N2 on. It takes ~1 hr to pressurized mix tank ! The volume of the tank is about 5.56 L at ambient pressure. write(6,'(a,/)') 'NOTE, CH4+N2 mix tank is ~ 11 L @ 0 psig, so initial purge time: 4.6 hr' 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.2,'' O2:'',f6.2,'' CO2:'',f7.3,'' CH4:'',f7.4,$)' write(6,longStr) (endT-beginT)/60., seqNames(i), real(dataMat(i,5)), (real(dataMat(i,j)),j=7,9) ! 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; SL_ch4 = SL_ch4_new ! update gas composition in sample loop longStr = '(2(i2.2,''/''),i2,1x,2(i2.2,'':''),i2.2,1x,a8,##x,f4.0,3x,f4.1,3x,f5.2,3x,f4.2,3x,f5.2,3x,f6.2)' write(longStr(43:44),'(i2)') i ip = 9 if (seqMCs(i)==1) ip = 11 ! 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(%) CH4(%) pH DO(uM) ' 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 (ch4Port ) 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 MonitorGasesA2M 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),6(1x,f7.4))' write(datUnit,longStr) (dataVec(j),j=1,12) longStr = '(\,1x,f10.5,1x,f4.0,2(1x,f5.2),2(1x,f6.2),1x,f6.2,1x,f7.3,1x,f8.4,1x,f5.3,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:11) 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 exchange flow rate between 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 and PAR values.' 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 ALGAE feed gas comp? (y/n): ' read(5,'(a)') lineRead if (scan(lineRead,'yY') /= 0) then write(6,'(a)') 'Enter ALGAE feed gas concentrations:' write(6,'(a,$)') 'O2 (%): ' read(5,*) o2Feed_Alg write(6,'(a,$)') 'CO2 (%): ' read(5,*) co2Feed_Alg end if write(6,'(a,$)') 'Change CH4% in calibration mixture? (y/n): ' read(5,'(a)') lineRead if (scan(lineRead,'yY') /= 0) then write(6,'(a,$)') 'Enter new user changed CH4 (%): ' read(5,*) ch4Mix end if call saveNote () call writeRecovery ! update recovery file getOpt = .false. case (5) ! get new value for flow rate between reactors write(6,'(a,$)') 'Enter new exchange flow rate (mL/d): ' read(5,*) flowEx 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 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 PAR and Temp write(6,'(a,$)') 'Enter PAR for algal reactor (uE/ms/s): ' read(5,*) PAR 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_Alg, co2Feed_Alg/) dataVec(9:12) = (/o2Adj, co2Adj, ch4Adj_L, ch4Adj_H/) ! Set the rest of ocVec ocVec(8:12) = (/tempC, flowEx, PAR, MCrpm(name2seq('Algae')), MCrpm(name2seq('Dig'))/) 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 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,f10.5,5(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 select case (name) case('CH4mix') if (onoff == 1) then ! turn on valve call redHat(CH4mixOn) call CH4mixValves(1) ! turns on the two MFC for CH4 and N2 else !turn off valve call redHat(CH4mixOff) call CH4mixValves(0) ! turns off the two MFC for CH4 and N2 end if case('Air') if (onoff == 1) then ! turn on valve call redHat(AirOn) ! Increase air+co2 feed rate to Air+co2 mix tank call getGasFlow (mfcAlg, flowRate) ! get the flow rate to the algal reactor call changeAirSupply (flowRate + airMixPur) ! adds airMixPur to the algal sparging rate else !turn off valve call redHat(AirOff) ! Return air+co2 feed rate to Air+co2 mix tank to nominal value call getGasFlow (mfcAlg, flowRate) ! get the flow rate to the algal reactor call changeAirSupply (flowRate*airMixSup) ! air+co2 supply must be slightly higher that sparging rate. end if case('Algae') ! Nothing to change return case('N2') if (onoff == 1) then ! turn on valve call redHat(N2On) else !turn off valve call redHat(N2Off) end if case('Dig') ! Nothing to change return 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 writeWTDOT(cmdStr) ! get responce, which would just be the return of command call readWTDOT(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 algae or digestor reactors ! 7: O2, either raw and corrected ! 8: CO2, either raw and corrected ! 9: CH4, either raw and corrected ! 10: pH for algae or digestor reactors ! 11: DO for algae or digestor reactors !local declarations integer dt(8), ifail, i, name2seq real flow, o2, co2, ch4 ! 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) ! Sample CH4 call readCH4 (ch4) dvec(9) = dble(ch4) ! Zero out pH and DO in dvec dvec(10) = 0.0; dvec(11) = 0.0 ! Determine what to do based on name select case (name) case ('CH4mix') ! CH4 mixture is used to get the high offset on CH4 ch4Adj_H = ch4 - ch4Mix SL_o2_new = 0.; SL_co2_new = 0.; SL_ch4_new = ch4Mix ! not necessary case ('Air') ! Air is used to purge SL with air and get offsets for O2, CO2 and CH4_L o2Adj = o2 - o2Feed_Alg co2Adj = co2 - co2Feed_Alg ch4Adj_L = ch4 SL_o2_new = o2Feed_Alg SL_co2_new = co2Feed_Alg SL_ch4_new = 0.0 case ('Algae', 'Dig') ! Either algal or digestor reactors being sampled ! CH4mix and 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) dvec(9) = dvec(9) - dble( ch4Adj_L - (ch4Adj_H - ch4Adj_L)*ch4/ch4Mix ) ! Store the observed concentration to use for the next SL values SL_o2_new = dvec(7) SL_co2_new = dvec(8) SL_ch4_new = dvec(9) ! 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)) dvec(9) = dvec(9)*(1.0 + SLvol/MCheadSpaceVol(name2seq(name))) - SL_CH4*SLvol/MCheadSpaceVol(name2seq(name)) ! Get gas flow rate, pH and DO for appropriate reactor if (name == 'Algae') then call getGasFlow (mfcAlg, dvec(6)) call readpH(pHAlg, dvec(10)) call readDO(DOAlg, dvec(11)) else call getGasFlow (mfcDig, dvec(6)) call readpH(pHDig, dvec(10)) call readDO(DODig, dvec(11)) end if case ('N2') ! Purging SL with gas used for digestor (i.e. N2) ! Since N2 is not being used to determine an offset, return corrected values dvec(7) = dvec(7) - dble(o2Adj) dvec(8) = dvec(8) - dble(co2Adj) dvec(9) = dvec(9) - dble( ch4Adj_L - (ch4Adj_H - ch4Adj_L)*ch4/ch4Mix ) SL_o2_new = 0.; SL_co2_new = 0.; SL_ch4_new = 0. 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) SL_ch4_new = dvec(9) 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 ALGAE feed gas concentrations:' write(6,'(a,$)') 'O2 (%): ' read(5,*) o2Feed_Alg write(6,'(a,$)') 'CO2 (%)): ' read(5,*) co2Feed_Alg write(6,'(a,/)') 'Note, CO2% must be set manually on the 647c controller' write(6,'(a,$)') 'Enter CH4 for calibration (%): ' read(5,*) ch4Mix write(6,'(a,/)') 'Note, CH4% must be set manually on the 647c controller' ! get value for flow rate between reactors write(6,'(a,$)') 'Enter reactor exchange flow rate (mL/d): ' read(5,*) flowEx ! 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 PAR and Temp write(6,'(a,$)') 'Enter PAR for algal reactor (uE/ms/s): ' read(5,*) PAR write(6,'(a,$)') 'Enter Temperature of growth chamber (C): ' read(5,*) tempC ! 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 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 (ch4Port) 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 (ch4Port, (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 iresult = SPORT_CONNECT (ch4Port) ! 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 (ch4Port , 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. ! 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,$)') 'Turn on purge gases; Air [a], CH4 mix [m], N2 [n] or none : ' read(5,'(a)') lineRead name = 'Algae' ! This will not open or close any purge gas if (scan(lineRead,'aA') /= 0) name = 'Air' if (scan(lineRead,'mM') /= 0) name = 'CH4mix' if (scan(lineRead,'nN') /= 0) name = 'N2' if (lineRead /= ' ') Write(6,'(3a,i2)') 'Note, for ',trim(name),' use port: ', seqPorts(name2seq(name)) 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(%)" "CH4(%)"' 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 Algae or Dig do call readAnalyzers ('Raw', dvec) ! Store and display values write(iunit,'(f8.2,1x,f6.2,3(1x,f8.4))') 1440.*(dvec(1)+tAdj), dvec(5), dvec(7), dvec(8), dvec(9) ! 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.2,'' O2:'',f6.2,'' CO2:'',f7.3,'' CH4:'',f8.4,$)' write(6,longStr) real(1440.*(dvec(1)+tAdj)), int(dvec(2)), real(dvec(5)), (real(dvec(j)),j=7,9) ! 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 readCH4 (ch4Ave) ! This routine reads CH4 concentration from CAI device. ! Ver 2: 18 Mar 2010; I have notice problems with reading the CAI device, also ! I want to average several reads together. ! Once the Measured concentration string is sent (AKON K1), the data string returned will ! look something like: ! STX_AKON 0 2.900818 919879468ETXSTX_AKON 0 2.900819 919879469ETX ! Where its starts with an STX character and is terminated by an ETX char. ! If no errors are returned, then the first 8 characters following the STX are: ! "_AKON 0 " ! which is then followed by two numbers, the first being the gas concentration and ! the second a time stamp in 1/10's of a second. Also, I've noticed that the ! device seems to send two (or maybe one and a half) return responces. ! This current version parses the last completed AKON returned. ! ! Ver 2.1 25 Jun 2010 ! If the analyzer output exceeds its range (i.e., 0-5%), it will trigger an error ! so the response will be ! "_AKON # " ! where # is any digit between 1 and 9. If there are no errors, then a 0 is returned. ! Since I'm now running gas mix at 4.9%, instrument drift can cause it to exceed 5.0, ! but the data is still good, so I have removed the check only to look for the first 6 ! characters as in: ! "_AKON " use CommParameters implicit none real ch4Ave ! Local declaratiosn integer, parameter:: aveReads = 10 ! Number of samples to average together. integer, parameter:: maxTime = 1 ! maximum time to wait for a response (sec). integer i, ok2read ,byteCnt, byteCntP, iresult, j, nPts integer iSTX, iETX real ch4, timeStamp real tstart, tend character dataStr*1024 nPts = 0 do i=1,aveReads ! Commands start with STX and are terminated with ETX iresult = SPORT_WRITE_DATA (ch4Port, STX//' AKON K1 '//ETX, 11) ! Since SPORT_READ_DATA will hold execution until at least on char is in the buffer, make sure ! there is one, since if the device dies, we don't want the whole program to hang ! here. ! It appears that it can take some time ( ~0.2 sec) for the port to respond ! so wait a bit for the response to occur call cpu_time(tstart) tend = tstart do while (tend-tstart <= maxTime) iresult = SPORT_PEEK_DATA (ch4Port, ok2read ,byteCntP) if (byteCntP >= 20) exit ! 20 characterts is probably not enough, but it could be if timestamp is only 1 char long. call cpu_time(tend) end do if (.not. ok2read) cycle ! data not in buffer, try again. ! Read the entire buffer (or at least dataStr bytes of) iresult = SPORT_READ_DATA (ch4Port, dataStr, byteCnt) ! Starting from the end, find the first complete response between STX and ETX iETX = index(trim(dataStr),ETX, back=.true.) if (iETX < 20) cycle ! There is not enough info in the string for a complete read, so try again iSTX=index(dataStr(1:iETX),STX, back=.true.) if (iSTX == 0) cycle ! STX could not be found in sub string, start again ! A full string record has been found, make sure response is "_AKON " ! if (index(dataStr(iSTX:iETX),'_AKON 0 ') == 2) then if (index(dataStr(iSTX:iETX),'_AKON ') == 2) then ! looks good, read values and add to average read(dataStr(iSTX+9:iETX-1),*) ch4, timeStamp !write(100,'(f8.6,1x,i2,1x,f5.3,1x,i4,1x,a)') ch4, i, tend-tstart, byteCntP, trim(dataStr) ! remove this else ! Error must have been returned in reponse, so try again. While there may ! be good data still in dataStr, just go ahead and read the buffer again. cycle end if nPts = nPts + 1 if (nPts == 1) then ! ch4Ave must be initialized ch4Ave = ch4 cycle end if ch4Ave = ch4Ave + (ch4 - ch4Ave)/real(nPts) ! running average. end do if (nPts == 0) ch4Ave = badRead !write(100,'(f8.6,1x,I4)') ch4Ave, nPts ! remove this return end subroutine readCH4 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 readWTDOT(outStr) ! This routine reads outStr from a Weeder Tech WTDOT 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: ARB !this asks for the state of channel B on board with prefix A ! Example responce to above: ABH ! By specifing SPORT_CONNECT and using LINE reads and write, the character can be easily handled. use CommParameters implicit none 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 E in case read fails. do i=1,maxAtmp ! Read a module, but allow maxTime sectonds for response to be place in buffer. call cpu_time(tstart) tend = tstart do while (tend-tstart <= maxTime) iresult = SPORT_PEEK_LINE (WTDOTport, 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 (WTDOTport, outStr, byteCnt) iresult = SPORT_PEEK_LINE (WTDOTport, ok2read ,byteCnt) end do exit end do return end subroutine readWTDOT Subroutine writeWTDOT(inStr) ! This routine write inStr to a Weeder Tech WTDOT module. ! Only the last record in the buffer is returned. use CommParameters implicit none character inStr*(*) ! input command string, and output of responce if requrested ! Local declarations integer iresult iresult = SPORT_WRITE_LINE (WTDOTport, trim(inStr), 0) if (iresult /= 0) write(6,*) 'WARNING writing to WTDOT::iresult = ',iresult return end subroutine writeWTDOT Subroutine readWTAIN(outStr) ! This routine reads outStr from a Weeder Tech WTAIN 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: ARB !this read for the channel B on board with prefix A ! Example responce to above: ABH (for WDOT board) ! By specifing SPORT_CONNECT and using LINE reads and write, the character can be easily handled. use CommParameters implicit none 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 sectonds for response to be place in buffer. call cpu_time(tstart) tend = tstart do while (tend-tstart <= maxTime) iresult = SPORT_PEEK_LINE (WTAINport, 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 (WTAINport, outStr, byteCnt) iresult = SPORT_PEEK_LINE (WTAINport, ok2read ,byteCnt) end do exit end do return end subroutine readWTAIN Subroutine writeWTAIN(inStr) ! This routine write inStr to a Weeder Tech module. ! Only the last record in the buffer is returned. use CommParameters implicit none character inStr*(*) ! input command string, and output of responce if requrested ! Local declarations integer iresult iresult = SPORT_WRITE_LINE (WTAINport, trim(inStr), 0) if (iresult /= 0) write(6,*) 'WARNING writing to WTAINport::iresult = ',iresult return end subroutine writeWTAIN 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 writeWTAIN(str) call readWTAIN(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 writeWTAIN(str) call readWTAIN(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 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 real(8) mA character iostring*1024 call writeWTAIN(chan) call readWTAIN(iostring) ! should return voltage in mV in the string if (scan(iostring,'?') /= 0) then write(6,'(a)') 'Error reading pH on WTAIN board, value = '//trim(iostring) return end if read(iostring(2:),*) mA ! note, first character is the channel letter ! The Wayjun Analog Signal Isolators converts 0-20 mA to 0-10 V. ! If mA are less than 4, then this is an error indication from the device mA = 2.0*mA/1000.0 ! convert to mA if (mA < 4.0 .or. mA > 20.0) write(6,'(a)') 'Warning, pH outside 4-20 mA range..., continuing' ! Convert 4-20 mA signal to pH based on Hamilton settings pH = ((pH20 - pH4)*mA + (20.0*pH4 - 4.0*pH20))/(20.0 - 4.0) 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 real(8) mA character iostring*1024 call writeWTAIN(chan) call readWTAIN(iostring) ! should return voltage in mV in the string if (scan(iostring,'?') /= 0) then write(6,'(a)') 'Error reading DO on WTAIN board, value = '//trim(iostring) return end if read(iostring(2:),*) mA ! note, first character is the channel letter ! The Wayjun Analog Signal Isolators converts 0-20 mA to 0-10 V. ! If mA are less than 4, then this is an error indication from the device mA = 2.0*mA/1000.0 ! convert to mA if (mA < 4.0 .or. mA > 20.0) write(6,'(a)') 'Warning, DO outside 4-20 mA range..., continuing' ! Convert 4-20 mA signal to pH based on Hamilton settings 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 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 writeWTDOT(N2DryOn) ! get responce, which would just be the return of command call readWTDOT(outStr) if (outStr /= N2DryOn) then write(6,*) 'WARNING:: error turning N2 On' write(6,'(2a)') ' WTDOT Output response was: ',trim(outStr) end if call writeWTDOT(gasPumpOn) ! get responce, which would just be the return of command call readWTDOT(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 writeWTDOT(gasPumpOff) ! get responce, which would just be call readWTDOT(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 writeWTDOT(N2DryOff) ! get responce, which would just be the return of command call readWTDOT(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 ! 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' ! 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 algal reactor has been changed, then the air+CO2 mix flow must also be increased if (MFC == mfcAlg) then write(6,'(a)') 'Also changing air+co2 feed appropriately' call changeAirSupply (dble(setPoint*airMixSup)) end if end if return end subroutine changeSetpoint subroutine changeAirSupply (airFlow) ! this routine changes the flow of CO2 augmented air to match demand. ! The supply of air is set to airMixSup*gasFlow(mfcAlg), that is the flow to the algal reactor ! If the air purge is ON, then this flow is increased by adding airMixPur value. ! This routine assumes: ! that the CO2 MFC is running slave to the Air MFC, so this routine only changes the Air MFC. ! Also, it is assumed 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 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 MFCsOnOff () ! This routine is used to turn MFCs on or off use CommParameters 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 = 'UNKNOWN' ! There is not command to assess the state of the Main Valve do i=0,8 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 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 CH4mixValves (onoff) ! turns off or on the MFC for the CH4/N2 mixture for calibration ! Note, it takes about 1 hr for the mix tank to pressurize at ~100 sccm ! **** It is assumed that the main valvue (0) for the MKS 647c is ON use CommParameters implicit none integer onoff ! =1 turn on, =0 turn off ! local declarations character MFCi*4, junk*10 if (onoff == 1) then ! turn CH4valve and N2valve on MFCi = 'ON #' write(MFCi(4:4),'(i1)') mfcN2 call write647c(MFCi) call read647c(junk) ! flush from buffer write(MFCi(4:4),'(i1)') mfcCH4 call write647c(MFCi) call read647c(junk) ! flush from buffer else MFCi = 'OF #' write(MFCi(4:4),'(i1)') mfcN2 call write647c(MFCi) call read647c(junk) ! flush from buffer write(MFCi(4:4),'(i1)') mfcCH4 call write647c(MFCi) call read647c(junk) ! flush from buffer end if return end subroutine CH4mixValves 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