C This file is part of the ESP-r system.
C Copyright Energy Systems Research Unit, University of
C Strathclyde, Glasgow Scotland, 2001.
C ESP-r is free software. You can redistribute it and/or
C modify it under the terms of the GNU General Public
C License as published by the Free Software Foundation
C (version 2 orlater).
C ESP-r is distributed in the hope that it will be useful
C but WITHOUT ANY WARRANTY; without even the implied
C warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
C PURPOSE. See the GNU General Public License for more
C details.
C You should have received a copy of the GNU General Public
C License along with ESP-r. If not, write to the Free
C Software Foundation, Inc., 59 Temple Place, Suite 330,
C Boston, MA 02111-1307 USA.
C eroper.f provides the following facilities:
C EROPER: Reads all zone project data from a user-constructed
C datafile.
C EMKOPER: Write zone operation common block data to file.
C VNTINFO: English description of scheduled air flow and
C control from zone operation common block data.
C CASINFO: English description of scheduled casual gains
C from zone operation common block data.
C checkcascount scans current P3 & P3TYPE commons and refreshes
C loadcount() & load24() in common blocks loadcnt & loadall
C CPYCASIJ Copy one casual period jx to another ix for zone icomp and
C daytype idaytype.
C CPYCASIT Copy one casual period jx to backup variables for zone icomp
C and daytype idaytype.
C CPYCASTI Copy from backup variables to casual period jx for zone icomp
C and daytype idaytype.
C SORTCAS Sort an array of casual gains by casual gain type and then by
C starting time. (Uses a odified QUICKSORT).
C ******************** EROPER
C EROPER reads all zone project data from a user-constructed
C datafile.
C Common block variables are:
C oprdesc - operation notes (248 char)
C ITCTL - Thermostatic control index :
C control on zone coupled air temperature
C control on zone air temperature
C 0 no control
C control on zone air temperature and infiltration
C control on zone coupled air and infiltration
C ACIL, ACVL, - low level (i.e. if below a setpoint) for control.
C IVL, TAL
C ACIU, ACVU, - mid level (i.e. if above a setpoint) 1st stage options
C IVU, TAU for control.
C ACIH, ACVH, - high level (2nd stage options) for control.
C IVH, TAH
C NAC1, NAC2 & - number of distinct air change periods during Weekdays,
C NAC3 Saturdays and Sundays respectively.
C IACS1,IACF1, - start and finish hours of each of the above air change
C IACS2,IACF2, periods relating to Weekdays, Saturdays and Sundays
C IACS3 & IACF3 respectively.
C ACI1, ACI2 - natural infiltration air changes/hour for each period
C & ACI3 relating to Weekdays, Saturdays and Sundays
C respectively.
C ACV1, ACV2 - additional incoming air changes/hour for each period
C & ACV3 relating to Weekdays, Saturdays and Sundays
C respectively.
C IPT1, IPT2 - the additional incoming air (corresponding to ACV1,
C & IPT3 ACV2 & ACV3) can either be at constant temperature -
C changing, if required, between each period - or set
C at the time-dependent temperature of some coupled
C component. The IPT? variable controls this, where:
C IPT?=0 signifies a constant temperature will be specified
C IPT?=N (N>0) signifies that incoming air is at the
C time-dependent temperature of component N.
C TA1,TA2 & - correspond to IPT?=0 and define the temperature of the
C TA3 incoming air for each period relating to Weekdays,
C Saturdays and Sundays respectively.
C NCAS1,NCAS2 - number of casual gains during a typical Weekday,
C & NCAS3 Saturday and Sunday respectively.
C ICGT1,ICGT2 - Casual gain type:
C ICG3T 1. Occupancy
C 2. Lights
C 3. Equipment
C 4. User controllable gain (not fully utilised as yet)
C -1. Occupancy as floor area per person
C -2. Lights in w/m^2 per floor area
C -3. Equipment in w/m^2 per floor area
C ICGS1,ICGF1, - start and finish hours of each of the above casual gain
C ICGS2,ICGF2, periods
C ICGS3 & ICGF3
C CMGS1,CMGL1, - sensible and latent magnitude (in Watts) of
C CMGS2,CMGL2, each casual gain
C CMGS3 & CMGL3
C RADC1,CONC1, - radiant and convective portions (proportion
C RADC2,CONC2, of 1) of each casual gain
C RADC3,CONC3
C pf1-3 - power factor of electrical load.
C ipf1-3 - nature of load lagging (reactive), leading (capacative),
C or unity (pure resistive).
C pwr1-3 - real power consumption of the load (W).
C bvolt1-3 - operational voltage of the load.
C iphas1-3 - which phase the load is connected to (1-3) or
C all 3 (4).
C Maximum number of air change periods/day MA=5
C Maximum number of casual gains/day MC=20
SUBROUTINE EROPER(ITRC,ITRU,IUO,ICOMP,IER)
#include "building.h"
COMMON/OUTIN/IUOUT,IUIN
COMMON/C1/NCOMP,NCON
COMMON/C2/LSNAM,NCCODE(MCOM),LPROJ(MCOM),LGEOM(MCOM),
& LSHAD(MCOM),LTHRM(MCOM),INDUTL(MCOM),LUTIL(MCOM)
COMMON/P1/oprdesc,ctlstr
COMMON/P2/NAC1,IACS1(MA),IACF1(MA),ACI1(MA),ACV1(MA),
& IPT1(MA),TA1(MA),NAC2,IACS2(MA),IACF2(MA),ACI2(MA),
& ACV2(MA),IPT2(MA),TA2(MA),NAC3,IACS3(MA),IACF3(MA),
& ACI3(MA),ACV3(MA),IPT3(MA),TA3(MA)
COMMON/P2CTL/ITCTL(MCOM),TLO(MCOM),TUP(MCOM),THI(MCOM),ACIL(MCOM),
& ACVL(MCOM),IVL(MCOM),TAL(MCOM),ACIU(MCOM),ACVU(MCOM),
& IVU(MCOM),TAU(MCOM),ACIH(MCOM),ACVH(MCOM),
& IVH(MCOM),TAH(MCOM)
COMMON/P3/NCAS1,ICGS1(MC),ICGF1(MC),CMGS1(MC),CMGL1(MC),
& RADC1(MC),CONC1(MC),NCAS2,ICGS2(MC),ICGF2(MC),CMGS2(MC),
& CMGL2(MC),RADC2(MC),CONC2(MC),NCAS3,ICGS3(MC),ICGF3(MC),
& CMGS3(MC),CMGL3(MC),RADC3(MC),CONC3(MC)
COMMON/P3TYPE/ICGT1(MC),ICGT2(MC),ICGT3(MC)
C Version of operations file. ip3ver=0 standard, =1 sorted with header
common/p3ver/ip3ver
C Electrical data flag and elctrical data.
common/elecflg/ielf(mcom)
common/elp3/nel1,pf1(mc),ipf1(mc),pwr1(mc),bvolt1(mc),iphas1(mc),
& nel2,pf2(mc),ipf2(mc),pwr2(mc),bvolt2(mc),iphas2(mc),
& nel3,pf3(mc),ipf3(mc),pwr3(mc),bvolt3(mc),iphas3(mc)
C Descriptive label for a zone load or casual gain types.
common/loadlabel/lodlabel(mcom,7)
C Current file (for use by low level I/O calls). Error subroutine
C and error details for dll mode.
common/curfile/currentfile
common/dllerr/dllsubr,dllmesg
CHARACTER oprdesc*248,ctlstr*24,outstr*124,outs*124,lodlabel*6
CHARACTER*72 LSNAM,LPROJ,LGEOM,LSHAD,LUTIL,LTHRM,currentfile
character dllsubr*12,dllmesg*124,WORD*20,loutstr*248
character dstmp*24
logical havehi,dll
IER=0
C Check if running in dll mode.
call isadll(dll)
C Initialise project data file.
CALL EFOPSEQ(IUO,LPROJ(ICOMP),1,IER)
IF(IER.NE.0)THEN
write(outs,'(3a)') 'Operations file ',
& LPROJ(ICOMP)(1:lnblnk(LPROJ(ICOMP))),
& ' could not be opened.'
if(dll)then
dllsubr='EROPER'
dllmesg=outs
ier=2
return
else
call edisp(iuout,outs)
IER=1
RETURN
endif
ENDIF
currentfile=LPROJ(ICOMP)
ip3ver=0
C Initialise the iphase arrays to avoid zero array elements in precal.
C Initialise the following arrays. This is important
C in case no electrical data was specified becasuse they
C are later used in precal.F as indexing arrays.
do 909 iph=1, mc
iphas1(iph)=1
iphas2(iph)=1
iphas3(iph)=1
909 continue
C Read lines from file, discarding comments. Look for header on
C newer files. Older files will begin with a description. To allow for
C description with spaces copy directly from OUTSTR rather than parsing
C it into words.
CALL STRIPC(IUO,OUTSTR,0,ND,1,'oper name or header',IER)
IF(IER.NE.0) goto 1002
if(outstr(1:11).eq.'*Operations')then
if(outstr(13:15).eq.'1.0')then
ip3ver=1
elseif(outstr(13:15).eq.'2.0')then
ip3ver=2
endif
CALL STRIPC(IUO,OUTSTR,0,ND,1,'header',IER)
IF(IER.NE.0) goto 1002
K=0
CALL EGETW(OUTSTR,K,WORD,'W','header tags',IER)
IF(IER.NE.0) goto 1002
if(WORD(1:5).eq.'*Date'.or.WORD(1:5).eq.'*date')then
CALL EGETRM(OUTSTR,K,dstmp,'W','date stamp',IER)
endif
CALL LSTRIPC(IUO,LOUTSTR,0,ND,1,'oper notes',IER)
endif
oprdesc=LOUTSTR
C Thermostatic control data. If 4th item then
havehi = .false.
CALL STRIPC(IUO,OUTSTR,99,ND,1,'Thmst control',IER)
K=0
CALL EGETWI(OUTSTR,K,ITCTL(ICOMP),-14,4,'W','opr cntl',IER)
CALL EGETWR(OUTSTR,K,TLO(ICOMP),0.,0.,'-','lower temp',IER)
CALL EGETWR(OUTSTR,K,TUP(ICOMP),0.,0.,'-','mid temp',IER)
if(nd.eq.4)then
havehi=.true.
CALL EGETWR(OUTSTR,K,THI(ICOMP),0.,0.,'-','hi temp',IER)
else
THI(ICOMP)=100.0
endif
IF(IER.NE.0) goto 1002
C Generate a brief descrition and proceed acording to control type.
IY=ITCTL(ICOMP)
if(IY.eq.-14)then
ctlstr='infil only: wind speed '
elseif(IY.eq.-13)then
ctlstr='infil only: ext db temp '
elseif(IY.eq.-12)then
ctlstr='infil only: adj zone tmp'
elseif(IY.eq.-11)then
ctlstr='infil only: zone temp '
elseif(IY.eq.-4)then
ctlstr='vent only: wind speed '
elseif(IY.eq.-3)then
ctlstr='vent only: ext db temp '
elseif(IY.eq.-2)then
ctlstr='vent only: adj zone temp'
elseif(IY.eq.-1)then
ctlstr='vent only: zone temp '
elseif(IY.eq.4)then
ctlstr='infil & vent: wind speed'
elseif(IY.eq.3)then
ctlstr='infil & vent: ext db T '
elseif(IY.eq.2)then
ctlstr='infil & vent: adj zone T'
elseif(IY.eq.1)then
ctlstr='infil & vent: zone T '
elseif(IY.eq.0)then
ctlstr='no control of air flow '
goto 22
else
ctlstr='unknown flow control '
goto 1022
endif
CALL STRIPC(IUO,OUTSTR,0,ND,1,'Lower flow details',IER)
K=0
CALL EGETWR(OUTSTR,K,ACIL(ICOMP),0.,2000.,'W','l infil',IER)
CALL EGETWR(OUTSTR,K,ACVL(ICOMP),0.,2000.,'W','l vent',IER)
CALL EGETWI(OUTSTR,K,IVL(ICOMP),0,MCOM,'W','l vent zn',IER)
CALL EGETWR(OUTSTR,K,TAL(ICOMP),0.,0.,'-','l vent tmp',IER)
CALL STRIPC(IUO,OUTSTR,0,ND,1,'Mid flow details',IER)
K=0
CALL EGETWR(OUTSTR,K,ACIU(ICOMP),0.,2000.,'W','m infil',IER)
CALL EGETWR(OUTSTR,K,ACVU(ICOMP),0.,2000.,'W','m vent',IER)
CALL EGETWI(OUTSTR,K,IVU(ICOMP),0,MCOM,'W','m vent zn',IER)
CALL EGETWR(OUTSTR,K,TAU(ICOMP),0.,0.,'-','m vent tmp',IER)
IF(IER.NE.0) goto 1002
if(havehi)then
CALL STRIPC(IUO,OUTSTR,0,ND,1,'High flow details',IER)
K=0
CALL EGETWR(OUTSTR,K,ACIH(ICOMP),0.,2000.,'W','h inf',IER)
CALL EGETWR(OUTSTR,K,ACVH(ICOMP),0.,2000.,'W','h vent',IER)
CALL EGETWI(OUTSTR,K,IVH(ICOMP),0,MCOM,'W','h vent zn',IER)
CALL EGETWR(OUTSTR,K,TAH(ICOMP),0.,0.,'-','h vent tmp',IER)
IF(IER.NE.0) goto 1002
else
ACIH(ICOMP)=0.
ACVH(ICOMP)=0.
IVH(ICOMP)=0
TAH(ICOMP)=0.
endif
C Air change information.
C Weekdays.
22 CALL STRIPC(IUO,OUTSTR,0,ND,1,'Weekday flow periods',IER)
K=0
CALL EGETWI(OUTSTR,K,NAC1,0,MA,'W','Weekday periods',IER)
IF(NAC1.EQ.0)goto 2
DO 10 I=1,NAC1
CALL STRIPC(IUO,OUTSTR,0,ND,1,'Period flow details',IER)
K=0
CALL EGETWI(OUTSTR,K,IACS1(I),0,24,'W','w flow start',IER)
CALL EGETWI(OUTSTR,K,IACF1(I),0,24,'W','w flow end',IER)
CALL EGETWR(OUTSTR,K,ACI1(I),0.,2000.,'W','w infil',IER)
CALL EGETWR(OUTSTR,K,ACV1(I),0.,2000.,'W','w vent',IER)
CALL EGETWI(OUTSTR,K,IPT1(I),0,NCOMP,'W','w vent z',IER)
CALL EGETWR(OUTSTR,K,TA1(I),0.,0.,'-','w vent tmp',IER)
IF(IACS1(I).GT.IACF1(I))then
C Found a period out of order, warn user and carry on.
write(outs,'(2a)')' Weekday vent start-end mismatch in...',
& outstr(1:50)
call edisp(iuout,outs)
write(outs,'(2a)')' of operation file ',currentfile
call edisp(iuout,outs)
IER=1
endif
IF(IPT1(I).EQ.ICOMP)GOTO 1009
10 CONTINUE
C Saturdays.
2 CALL STRIPC(IUO,OUTSTR,0,ND,1,'Saturday flow periods',IER)
K=0
CALL EGETWI(OUTSTR,K,NAC2,0,MA,'W','Sat periods',IER)
IF(NAC2.EQ.0)GOTO 3
DO 20 I=1,NAC2
CALL STRIPC(IUO,OUTSTR,0,ND,1,'Period flow details',IER)
K=0
CALL EGETWI(OUTSTR,K,IACS2(I),0,24,'W','Sat flow str',IER)
CALL EGETWI(OUTSTR,K,IACF2(I),0,24,'W','Sat flow end',IER)
CALL EGETWR(OUTSTR,K,ACI2(I),0.,2000.,'W','Sat infil',IER)
CALL EGETWR(OUTSTR,K,ACV2(I),0.,2000.,'W','Sat vent',IER)
CALL EGETWI(OUTSTR,K,IPT2(I),0,NCOMP,'W','Sat vent z',IER)
CALL EGETWR(OUTSTR,K,TA2(I),0.,0.,'-','Sat vent tmp',IER)
IF(IACS2(I).GT.IACF2(I))then
C Found a period out of order, warn user and carry on.
write(outs,'(2a)')' Saturday vent start-end mismatch in...',
& outstr(1:50)
call edisp(iuout,outs)
write(outs,'(2a)')' of operation file ',currentfile
call edisp(iuout,outs)
IER=1
endif
IF(IPT2(I).EQ.ICOMP)goto 1009
20 CONTINUE
IF(IER.NE.0) goto 1002
C Sundays.
3 CALL STRIPC(IUO,OUTSTR,0,ND,1,'Sunday flow periods',IER)
K=0
CALL EGETWI(OUTSTR,K,NAC3,0,MA,'W','Sat periods',IER)
IF(NAC3.EQ.0)GOTO 4
DO 30 I=1,NAC3
CALL STRIPC(IUO,OUTSTR,0,ND,1,'Period flow details',IER)
K=0
CALL EGETWI(OUTSTR,K,IACS3(I),0,24,'W','Sun flow str',IER)
CALL EGETWI(OUTSTR,K,IACF3(I),0,24,'W','Sun flow end',IER)
CALL EGETWR(OUTSTR,K,ACI3(I),0.,2000.,'W','Sun infil',IER)
CALL EGETWR(OUTSTR,K,ACV3(I),0.,2000.,'W','Sun vent',IER)
CALL EGETWI(OUTSTR,K,IPT3(I),0,NCOMP,'W','Sun vent z',IER)
CALL EGETWR(OUTSTR,K,TA3(I),0.,0.,'-','Sun vent tmp',IER)
IF(IACS3(I).GT.IACF3(I))then
C Found a period out of order, warn user and carry on.
write(outs,'(2a)')' Sunday vent start-end mismatch in...',
& outstr(1:50)
call edisp(iuout,outs)
write(outs,'(2a)')' of operation file ',currentfile
call edisp(iuout,outs)
IER=1
endif
IF(IPT3(I).EQ.ICOMP)goto 1009
30 CONTINUE
IF(IER.NE.0) goto 1002
C Flow reporting if requested.
if(ITRC.GE.1)CALL VENTINF(ICOMP,ITRU)
C Casual gains.
C Weekdays.
4 CALL STRIPC(IUO,OUTSTR,0,ND,1,'Weekday gain periods',IER)
K=0
CALL EGETWI(OUTSTR,K,NCAS1,0,MC,'W','Week periods',IER)
IF(NCAS1.EQ.0)goto 5
DO 40 I=1,NCAS1
CALL STRIPC(IUO,OUTSTR,99,ND,1,'Period gain detl',IER)
K=0
if(ND.eq.7.or.ND.eq.12)then
CALL EGETWI(OUTSTR,K,ICGT1(I),-3,5,'W','wkd type',IER)
else
ICGT1(I)=1
endif
CALL EGETWI(OUTSTR,K,ICGS1(I),0,24,'W','wkd gain st',IER)
CALL EGETWI(OUTSTR,K,ICGF1(I),0,24,'W','wkd gain fn',IER)
CALL EGETWR(OUTSTR,K,CMGS1(I),0.,0.,'-','wkd sens',IER)
CALL EGETWR(OUTSTR,K,CMGL1(I),0.,0.,'-','wkd latent',IER)
CALL EGETWR(OUTSTR,K,RADC1(I),0.,1.,'W','wkd rad fr',IER)
CALL EGETWR(OUTSTR,K,CONC1(I),0.,1.,'W','wkd conv fr',IER)
IF(ICGS1(I).GT.ICGF1(I))then
C Found a period out of order, warn user and carry on.
write(outs,'(2a)')' Weekday gains start-end mismatch in...',
& outstr(1:50)
call edisp(iuout,outs)
write(outs,'(2a)')' of operation file ',currentfile
call edisp(iuout,outs)
IER=1
endif
X=RADC1(I)+CONC1(I)
IF(X.GT.1.1)then
write(outs,'(2a)')' Weekday rad & conv fractions > 1.0 in...',
& outstr(1:50)
call edisp(iuout,outs)
write(outs,'(2a)')' of operation file ',currentfile
call edisp(iuout,outs)
ier=1
endif
IF(X.LT..95.AND.ITRC.GT.1)call edisp(iuout,
& ' Casual gain rad:con sum < 1.0')
C Check if electrical data has also been saved.
if(ND.eq.12)then
CALL EGETWR(OUTSTR,K,PF1(I),0.,1.0,'W','wkd pf',IER)
CALL EGETWI(OUTSTR,K,IPF1(I),-1,1,'W','wkd lag lead',IER)
CALL EGETWR(OUTSTR,K,PWR1(I),0.,1000.,'-','wkd power',IER)
CALL EGETWR(OUTSTR,K,BVOLT1(I),0.,1000.,'-','wkd vlt',IER)
CALL EGETWI(OUTSTR,K,IPHAS1(I),1,4,'W','wkd phase',IER)
IELF(ICOMP)=1
endif
40 CONTINUE
IF(IER.NE.0) goto 1002
C Saturdays.
5 CALL STRIPC(IUO,OUTSTR,0,ND,1,'Saturday gain periods',IER)
K=0
CALL EGETWI(OUTSTR,K,NCAS2,0,MC,'W','Sat periods',IER)
IF(NCAS2.EQ.0)GOTO 6
DO 50 I=1,NCAS2
CALL STRIPC(IUO,OUTSTR,99,ND,1,'Period gain details',IER)
K=0
if(ND.eq.7.or.ND.eq.12)then
CALL EGETWI(OUTSTR,K,ICGT2(I),-3,5,'W','Sat type',IER)
else
ICGT2(I)=1
endif
CALL EGETWI(OUTSTR,K,ICGS2(I),0,24,'W','Sat gain st',IER)
CALL EGETWI(OUTSTR,K,ICGF2(I),0,24,'W','Sat gain fn',IER)
CALL EGETWR(OUTSTR,K,CMGS2(I),0.,0.,'-','Sat sens',IER)
CALL EGETWR(OUTSTR,K,CMGL2(I),0.,0.,'-','Sat latent',IER)
CALL EGETWR(OUTSTR,K,RADC2(I),0.,1.,'W','Sat rad fr',IER)
CALL EGETWR(OUTSTR,K,CONC2(I),0.,1.,'W','Sat conv fr',IER)
IF(ICGS2(I).GT.ICGF2(I))then
C Found a period out of order, warn user and carry on.
write(outs,'(2a)')' Saturday gains start-end mismatch in...',
& outstr(1:50)
call edisp(iuout,outs)
write(outs,'(2a)')' of operation file ',currentfile
call edisp(iuout,outs)
IER=1
endif
X=RADC2(I)+CONC2(I)
IF(X.GT.1.1)then
write(outs,'(2a)')' Saturday rad & conv fractions > 1.0 in..',
& outstr(1:50)
call edisp(iuout,outs)
write(outs,'(2a)')' of operation file ',currentfile
call edisp(iuout,outs)
ier=1
endif
IF(X.LT..95.AND.ITRC.GT.1)call edisp(iuout,
& ' Casual gain rad:con sum < 1.0')
if(ND.eq.12)then
CALL EGETWR(OUTSTR,K,PF2(I),0.,1.0,'W','Sat pf',IER)
CALL EGETWI(OUTSTR,K,IPF2(I),-1,1,'W','Sat lag lead',IER)
CALL EGETWR(OUTSTR,K,PWR2(I),0.,1000.,'-','Sat power',IER)
CALL EGETWR(OUTSTR,K,BVOLT2(I),0.,1000.,'-','Sat vlt',IER)
CALL EGETWI(OUTSTR,K,IPHAS2(I),1,4,'W','Sat phase',IER)
IELF(ICOMP)=1
endif
50 CONTINUE
C Sundays.
6 CALL STRIPC(IUO,OUTSTR,0,ND,1,'Sunday gain periods',IER)
K=0
CALL EGETWI(OUTSTR,K,NCAS3,0,MC,'W','Sun periods',IER)
IF(NCAS3.EQ.0)GOTO 8
DO 60 I=1,NCAS3
CALL STRIPC(IUO,OUTSTR,99,ND,1,'Period gain details',IER)
K=0
if(ND.eq.7.or.ND.eq.12)then
CALL EGETWI(OUTSTR,K,ICGT3(I),-3,5,'W','Sun type',IER)
else
ICGT3(I)=1
endif
CALL EGETWI(OUTSTR,K,ICGS3(I),0,24,'W','Sun gain st',IER)
CALL EGETWI(OUTSTR,K,ICGF3(I),0,24,'W','Sun gain fn',IER)
CALL EGETWR(OUTSTR,K,CMGS3(I),0.,0.,'-','Sun sens',IER)
CALL EGETWR(OUTSTR,K,CMGL3(I),0.,0.,'-','Sun latent',IER)
CALL EGETWR(OUTSTR,K,RADC3(I),0.,1.,'W','Sun rad fr',IER)
CALL EGETWR(OUTSTR,K,CONC3(I),0.,1.,'W','Sun conv fr',IER)
IF(ICGS3(I).GT.ICGF3(I))then
C Found a period out of order, warn user and carry on.
write(outs,'(2a)')' Sunday gains start-end mismatch in...',
& outstr(1:50)
call edisp(iuout,outs)
write(outs,'(2a)')' of operation file ',currentfile
call edisp(iuout,outs)
IER=1
endif
X=RADC3(I)+CONC3(I)
IF(X.GT.1.1)then
write(outs,'(2a)')' Sunday rad & conv fractions > 1.0 in...',
& outstr(1:50)
call edisp(iuout,outs)
write(outs,'(2a)')' of operation file ',currentfile
call edisp(iuout,outs)
ier=1
endif
IF(X.LT..95.AND.ITRC.GT.1)call edisp(iuout,
& ' Casual gain rad:con sum < 1.0')
if(ND.eq.12)then
CALL EGETWR(OUTSTR,K,PF3(I),0.,1.0,'W','Sun pf',IER)
CALL EGETWI(OUTSTR,K,IPF3(I),-1,1,'W','Sun lag lead',IER)
CALL EGETWR(OUTSTR,K,PWR3(I),0.,1000.,'-','Sun power',IER)
CALL EGETWR(OUTSTR,K,BVOLT3(I),0.,1000.,'-','Sun vlt',IER)
CALL EGETWI(OUTSTR,K,IPHAS3(I),1,4,'W','Sun phase',IER)
IELF(ICOMP)=1
endif
60 CONTINUE
C Check to see if gain labels have been added to the end of the file
8 CALL STRIPC(IUO,OUTSTR,99,ND,1,'Type labels',IERV)
IF(ND.NE.3.OR.IERV.ne.0) THEN
goto 1001
ELSE
K=0
DO 1234 ITYP=1,3
CALL EGETW(OUTSTR,K,lodlabel(ICOMP,ITYP),'W',
& 'type label',IER)
1234 CONTINUE
ENDIF
1235 CONTINUE
C Gain reporting if requested.
if(ITRC.GE.1)call CASINF(ICOMP,ITRU)
C Now free project data file.
CALL ERPFREE(IUO,ISTAT)
RETURN
C Error messages.
1000 if(dll)then
dllsubr='EROPER'
dllmesg=outs
ier=2
CALL ERPFREE(IUO,ISTAT)
return
else
call edisp(iuout,outs)
IER=1
CALL ERPFREE(IUO,ISTAT)
RETURN
endif
1001 call usrmsg(' ',
& ' No casual gains type names found ...supplying defaults.','-')
lodlabel(icomp,1)='Occupt'
lodlabel(icomp,2)='Lights'
lodlabel(icomp,3)='Equipt'
goto 1235
1002 write(outs,'(3a)') 'Conversion error in...',OUTSTR(1:50),'...'
if(dll)then
dllsubr='EROPER'
dllmesg=outs
ier=2
CALL ERPFREE(IUNIT,ios)
return
else
call edisp(iuout,outs)
IER=1
CALL ERPFREE(IUNIT,ios)
RETURN
endif
1009 write(outs,'(2a)')' Vent not from `another` zone in ...',
& outstr(1:50)
goto 1000
1022 write(outs,'(2a)')' Scheduled infiltration control unknown in',
& outstr(1:50)
goto 1000
END
C --------- EMKOPER
C Write zone operation common block data to file. It is assumed
C that this information has been checked. OPFIL is the name of
C the file to be written to (confirm if to be overwritten).
C ICOMP is the zone number.
C ITRC unit number for user output, IER=0 OK IER=1 problem.
SUBROUTINE EMKOPER(IUO,OPFIL,ICOMP,ITRU,IER)
#include "building.h"
COMMON/OUTIN/IUOUT,IUIN
COMMON/precz/zname(MCOM),zdesc(MCOM)
COMMON/P1/oprdesc,ctlstr
COMMON/P2/NAC1,IACS1(MA),IACF1(MA),ACI1(MA),ACV1(MA),
& IPT1(MA),TA1(MA),NAC2,IACS2(MA),IACF2(MA),ACI2(MA),
& ACV2(MA),IPT2(MA),TA2(MA),NAC3,IACS3(MA),IACF3(MA),
& ACI3(MA),ACV3(MA),IPT3(MA),TA3(MA)
COMMON/P2CTL/ITCTL(MCOM),TLO(MCOM),TUP(MCOM),THI(MCOM),ACIL(MCOM),
& ACVL(MCOM),IVL(MCOM),TAL(MCOM),ACIU(MCOM),ACVU(MCOM),
& IVU(MCOM),TAU(MCOM),ACIH(MCOM),ACVH(MCOM),
& IVH(MCOM),TAH(MCOM)
COMMON/P3/NCAS1,ICGS1(MC),ICGF1(MC),CMGS1(MC),CMGL1(MC),
& RADC1(MC),CONC1(MC),NCAS2,ICGS2(MC),ICGF2(MC),CMGS2(MC),
& CMGL2(MC),RADC2(MC),CONC2(MC),NCAS3,ICGS3(MC),ICGF3(MC),
& CMGS3(MC),CMGL3(MC),RADC3(MC),CONC3(MC)
COMMON/P3TYPE/ICGT1(MC),ICGT2(MC),ICGT3(MC)
C Version of operations file. ip3ver=0 standard, =1 sorted with header
common/p3ver/ip3ver
C Electrical data flag and elctrical data.
common/elecflg/ielf(mcom)
common/elp3/nel1,pf1(mc),ipf1(mc),pwr1(mc),bvolt1(mc),iphas1(mc),
& nel2,pf2(mc),ipf2(mc),pwr2(mc),bvolt2(mc),iphas2(mc),
& nel3,pf3(mc),ipf3(mc),pwr3(mc),bvolt3(mc),iphas3(mc)
C Descriptive label for a zone load or casual gain.
common/loadlabel/lodlabel(mcom,7)
COMMON/Vld20/Vldtng
common/curfile/currentfile
character OPFIL*72,zname*12,oprdesc*248,ctlstr*24,lodlabel*6
character zdesc*64,currentfile*72
character dstmp*24
logical Vldtng
IER=0
C Open any existing file by this name (ask user for confirmation to
C over-write) or create a new file.
if(Vldtng)then
CALL EFOPSEQ(IUO,OPFIL,3,IER)
currentfile=OPFIL
else
CALL EFOPSEQ(IUO,OPFIL,4,IER)
currentfile=OPFIL
endif
IF(IER.LT.0)THEN
IER=1
RETURN
ENDIF
C If version 1 write out header.
call dstamp(dstmp)
if(ip3ver.eq.1)then
WRITE(IUO,'(A)',IOSTAT=IOS,ERR=1) '*Operations 1.0'
WRITE(IUO,'(3a)',IOSTAT=IOS,ERR=1) '*date ',dstmp,
& ' # latest file modification '
elseif(ip3ver.eq.2)then
WRITE(IUO,'(A)',IOSTAT=IOS,ERR=1) '*Operations 2.0'
WRITE(IUO,'(3a)',IOSTAT=IOS,ERR=1) '*date ',dstmp,
& ' # latest file modification '
endif
WRITE(IUO,30,IOSTAT=IOS,ERR=1)
& zname(ICOMP)(1:lnblnk(zname(ICOMP))),OPFIL(:lnblnk(OPFIL))
30 FORMAT('# operations of ',a,' defined in: ',/,'# ',a)
C Write the common block data to the file.
WRITE(IUO,'(A)',IOSTAT=IOS,ERR=1)oprdesc(1:lnblnk(oprdesc))
WRITE(IUO,'(3A)',IOSTAT=IOS,ERR=1)
& '# control(',ctlstr,'), low mid & high setpoints '
WRITE(IUO,'(I4,3F10.3)',IOSTAT=IOS,ERR=1)ITCTL(ICOMP),
& TLO(ICOMP),TUP(ICOMP),THI(ICOMP)
IF(ITCTL(ICOMP).NE.0)THEN
WRITE(IUO,'(A)',IOSTAT=IOS,ERR=1)
& '# lower: infil, vent, source, data'
WRITE(IUO,'(2F10.3,I5,F10.3)')ACIL(ICOMP),ACVL(ICOMP),
& IVL(ICOMP),TAL(ICOMP)
WRITE(IUO,'(A)',IOSTAT=IOS,ERR=1)
& '# middle: infil, vent, source, data'
WRITE(IUO,'(2F10.3,I5,F10.3)')ACIU(ICOMP),ACVU(ICOMP),
& IVU(ICOMP),TAU(ICOMP)
WRITE(IUO,'(A)',IOSTAT=IOS,ERR=1)
& '# high: infil, vent, source, data'
WRITE(IUO,'(2F10.3,I5,F10.3)')ACIH(ICOMP),ACVH(ICOMP),
& IVH(ICOMP),TAH(ICOMP)
ENDIF
WRITE(IUO,'(1X,I5,A)',IOSTAT=ISTAT,ERR=1)NAC1,
& ' # no Weekday flow periods'
IF (NAC1 .GT. 0)THEN
WRITE(IUO,'(A)',IOSTAT=IOS,ERR=1)
& '# Wkd: start, stop, infil, ventil, source, data'
DO 1120 I = 1,NAC1
WRITE(IUO,5450,IOSTAT=IOS,ERR=1)IACS1(I),IACF1(I),
& ACI1(I),ACV1(I),IPT1(I),TA1(I)
1120 CONTINUE
ENDIF
WRITE(IUO,'(1X,I5,A)',IOSTAT=IOS,ERR=1)NAC2,
& ' # no Saturday flow periods'
IF (NAC2 .GT. 0)THEN
WRITE(IUO,'(A)',IOSTAT=IOS,ERR=1)
& '# Sat: start, stop, infil, ventil, source, data'
DO 1140 I = 1,NAC2
WRITE(IUO,5450,IOSTAT=IOS,ERR=1)IACS2(I),IACF2(I),
& ACI2(I),ACV2(I),IPT2(I),TA2(I)
1140 CONTINUE
ENDIF
WRITE(IUO,'(1X,I5,A)',IOSTAT=IOS,ERR=1)NAC3,
& ' # no Sunday flow periods '
IF (NAC3 .GT. 0)THEN
WRITE(IUO,'(A)',IOSTAT=IOS,ERR=1)
& '# Sun: start, stop, infil, ventil, source, data'
DO 1145 I = 1,NAC3
WRITE(IUO,5450,IOSTAT=IOS,ERR=1)IACS3(I),IACF3(I),
& ACI3(I),ACV3(I),IPT3(I),TA3(I)
1145 CONTINUE
ENDIF
WRITE(IUO,'(1X,I5,A)',IOSTAT=IOS,ERR=1)NCAS1,
& ' # no Weekday casual gains '
IF (NCAS1 .GT. 0)THEN
IF(IELF(ICOMP).EQ.1) THEN
WRITE(IUO,'(a,a)',IOSTAT=IOS,ERR=1)
& '# Wk: typ, sta, fin, sen, lat, rad, ',
& 'con, pf, +/-, pwr, volt, pha'
DO 1159 I = 1,NCAS1
WRITE(IUO,5470,IOSTAT=IOS,ERR=1)ICGT1(I),ICGS1(I),
& ICGF1(I),CMGS1(I),CMGL1(I),RADC1(I),CONC1(I),
& PF1(I),IPF1(I),PWR1(I),BVOLT1(I),IPHAS1(I)
1159 CONTINUE
ELSE
WRITE(IUO,'(A)',IOSTAT=IOS,ERR=1)
& '# Wkd: type, start, stop, sens, latent, rad_frac, conv_frac'
DO 1160 I = 1,NCAS1
WRITE(IUO,5460,IOSTAT=IOS,ERR=1)ICGT1(I),ICGS1(I),
& ICGF1(I),CMGS1(I),CMGL1(I),RADC1(I),CONC1(I)
1160 CONTINUE
ENDIF
ENDIF
WRITE(IUO,'(1X,I5,A)',IOSTAT=IOS,ERR=1)NCAS2,
& ' # no Saturday casual gains '
IF (NCAS2 .GT. 0)THEN
IF(IELF(ICOMP).EQ.1) THEN
WRITE(IUO,'(a,a)',IOSTAT=IOS,ERR=1)
& '# Wk: typ, sta, fin, sen, lat, rad, ',
& 'con, pf, +/-, pwr, volt, pha'
DO 1179 I = 1,NCAS2
WRITE(IUO,5470,IOSTAT=IOS,ERR=1)ICGT2(I),ICGS2(I),
& ICGF2(I),CMGS2(I),CMGL2(I),RADC2(I),CONC2(I),
& PF2(I),IPF2(I),PWR2(I),BVOLT2(I),IPHAS2(I)
1179 CONTINUE
ELSE
WRITE(IUO,'(A)',IOSTAT=IOS,ERR=1)
& '# Sat: type, start, stop, sens, latent, rad_frac, conv_frac'
DO 1180 I = 1,NCAS2
WRITE(IUO,5460,IOSTAT=IOS,ERR=1)ICGT2(I),ICGS2(I),
& ICGF2(I),CMGS2(I),CMGL2(I),RADC2(I),CONC2(I)
1180 CONTINUE
ENDIF
ENDIF
WRITE(IUO,'(1X,I5,A)',IOSTAT=IOS,ERR=1)NCAS3,
& ' # no Sunday casual gains '
IF (NCAS3 .GT. 0)THEN
IF(IELF(ICOMP).EQ.1) THEN
WRITE(IUO,'(a,a)',IOSTAT=IOS,ERR=1)
& '# Wk: typ, sta, fin, sen, lat, rad, ',
& 'con, pf, +/-, pwr, volt, pha'
DO 1181 I = 1,NCAS3
WRITE(IUO,5470,IOSTAT=IOS,ERR=1)ICGT3(I),ICGS3(I),
& ICGF3(I),CMGS3(I),CMGL3(I),RADC3(I),CONC3(I),
& PF3(I),IPF3(I),PWR3(I),BVOLT3(I),IPHAS3(I)
1181 CONTINUE
ELSE
WRITE(IUO,'(A)',IOSTAT=IOS,ERR=1)
& '# Sun: type, start, stop, sens, latent, rad_frac, conv_frac'
DO 1185 I = 1,NCAS3
WRITE(IUO,5460,IOSTAT=IOS,ERR=1)ICGT3(I),ICGS3(I),
& ICGF3(I),CMGS3(I),CMGL3(I),RADC3(I),CONC3(I)
1185 CONTINUE
ENDIF
ENDIF
5450 FORMAT(1X,I3,',',I3,',',2F9.3,I5,F9.3)
5460 FORMAT(1X,3(I4,','),F9.1,',',F9.1,',',F6.3,',',F6.3)
5470 FORMAT(1X,3(I3,','),F7.1,',',F7.1,',',F4.1,',',F4.1,',',F5.2,
& ',',I2,',',F7.1,',',F7.1,',',I2)
C Write out the type labels to the file for future reference
WRITE(IUO,'(a)')'# Labels for gain types '
WRITE(IUO,'(3(1X,A6))',IOSTAT=IOS,ERR=1)
& (lodlabel(icomp,I),I=1,3)
CALL ERPFREE(IUO,ISTAT)
RETURN
1 if(IOS.eq.2)then
call usrmsg(' No permission to write operations file!',
& ' returning to menu...','W')
else
call usrmsg(' Operations file transfer error !',
& ' returning to menu...','W')
endif
RETURN
END
C ******************* VENTINF
C VNTINFO provides an English description of scheduled air flow and
C control from zone operation common block data.
SUBROUTINE VENTINF(ICOMP,ITRU)
#include "building.h"
COMMON/P1/oprdesc,ctlstr
COMMON/PREC2/VOL(MCOM)
COMMON/P2/NAC1,IACS1(MA),IACF1(MA),ACI1(MA),ACV1(MA),
& IPT1(MA),TA1(MA),NAC2,IACS2(MA),IACF2(MA),ACI2(MA),
& ACV2(MA),IPT2(MA),TA2(MA),NAC3,IACS3(MA),IACF3(MA),
& ACI3(MA),ACV3(MA),IPT3(MA),TA3(MA)
COMMON/P2CTL/ITCTL(MCOM),TLO(MCOM),TUP(MCOM),THI(MCOM),ACIL(MCOM),
& ACVL(MCOM),IVL(MCOM),TAL(MCOM),ACIU(MCOM),ACVU(MCOM),
& IVU(MCOM),TAU(MCOM),ACIH(MCOM),ACVH(MCOM),
& IVH(MCOM),TAH(MCOM)
CHARACTER outs*124, oprdesc*248,ctlstr*24
call edisp(itru,' Operation notes:')
call edisp248(itru,oprdesc,72)
IY=ITCTL(ICOMP)
if(IY.eq.-14)then
ctlstr='infil only: wind speed '
elseif(IY.eq.-13)then
ctlstr='infil only: ext db temp '
elseif(IY.eq.-12)then
ctlstr='infil only: adj zone tmp'
elseif(IY.eq.-11)then
ctlstr='infil only: zone temp '
elseif(IY.eq.-4)then
ctlstr='vent only: wind speed '
elseif(IY.eq.-3)then
ctlstr='vent only: ext db temp '
elseif(IY.eq.-2)then
ctlstr='vent only: adj zone temp'
elseif(IY.eq.-1)then
ctlstr='vent only: zone temp '
elseif(IY.eq.4)then
ctlstr='infil & vent: wind speed'
elseif(IY.eq.3)then
ctlstr='infil & vent: ext db T '
elseif(IY.eq.2)then
ctlstr='infil & vent: adj zone T'
elseif(IY.eq.1)then
ctlstr='infil & vent: zone T '
elseif(IY.eq.0)then
ctlstr='no control of air flow '
else
ctlstr='unknown flow control '
endif
write(outs,'(a,a)') ' Control: ',ctlstr
call edisp(itru,outs)
if(IY.eq.0) goto 1225
WRITE(outs,'(A,3F7.2)')' Lower/Middle/High temp setpoints: ',
& TLO(ICOMP),TUP(ICOMP),THI(ICOMP)
call edisp(itru,outs)
write(outs,'(20x,a,a)')'Infil. ac/h m^3/s Vent. ac/h m^3/s ',
& ' from data'
call edisp(itru,outs)
acilm = (VOL(ICOMP)*ACIL(ICOMP))/3600.0
acvlm = (VOL(ICOMP)*ACVL(ICOMP))/3600.0
WRITE(outs,'(A,F9.3,F8.4,F10.3,F8.4,I5,F10.3)')
& ' Lower range data ',ACIL(ICOMP),acilm,
& ACVL(ICOMP),acvlm,IVL(ICOMP),TAL(ICOMP)
call edisp(itru,outs)
acium = (VOL(ICOMP)*ACIU(ICOMP))/3600.0
acvum = (VOL(ICOMP)*ACVU(ICOMP))/3600.0
WRITE(outs,'(A,F9.3,F8.4,F10.3,F8.4,I5,F10.3)')
& ' Middle range data',ACIU(ICOMP),acium,
& ACVU(ICOMP),acvum,IVU(ICOMP),TAU(ICOMP)
call edisp(itru,outs)
acihm = (VOL(ICOMP)*ACIH(ICOMP))/3600.0
acvhm = (VOL(ICOMP)*ACVH(ICOMP))/3600.0
WRITE(outs,'(A,F9.3,F8.4,F10.3,F8.4,I5,F10.3)')
& ' High range data ',ACIH(ICOMP),acihm,
& ACVH(ICOMP),acvhm,IVH(ICOMP),TAH(ICOMP)
call edisp(itru,outs)
1225 CONTINUE
WRITE(outs,'(A,3I3)')
& ' Number of Weekday Sat Sun air change periods =',NAC1,NAC2,NAC3
call edisp(itru,' ')
call edisp(itru,outs)
if(NAC1.eq.0.and.NAC2.eq.0.and.NAC3.eq.0)then
return
else
call edisp(itru,
&' Period Infiltration Ventilation From Source')
call edisp(itru,
&' id Hours Rate ac/h m3/s Rate ac/h m3/s Zone Temp.')
IF(NAC1.GT.0)THEN
DO 1230 I=1,NAC1
acim = (VOL(ICOMP)*ACI1(I))/3600.0
acvm = (VOL(ICOMP)*ACV1(I))/3600.0
WRITE(outs,'(a,2i3,a,i2,F9.2,F8.4,F8.2,F8.4,I4,F9.2)')'Wkd',
& I,IACS1(I),' - ',IACF1(I),ACI1(I),acim,ACV1(I),
& acvm,IPT1(I),TA1(I)
call edisp(itru,outs)
1230 CONTINUE
ENDIF
IF(NAC2.GT.0)THEN
DO 1250 I=1,NAC2
acim = (VOL(ICOMP)*ACI2(I))/3600.0
acvm = (VOL(ICOMP)*ACV2(I))/3600.0
WRITE(outs,'(a,2i3,a,i2,F9.2,F8.4,F8.2,F8.4,I4,F9.2)')'Sat',
& I,IACS2(I),' - ',IACF2(I),ACI2(I),acim,ACV2(I),
& acvm,IPT2(I),TA2(I)
call edisp(itru,outs)
1250 CONTINUE
ENDIF
IF(NAC3.GT.0)THEN
DO 1255 I=1,NAC3
acim = (VOL(ICOMP)*ACI3(I))/3600.0
acvm = (VOL(ICOMP)*ACV3(I))/3600.0
WRITE(outs,'(a,2i3,a,i2,F9.2,F8.4,F8.2,F8.4,I4,F9.2)')'Sun',
& I,IACS3(I),' - ',IACF3(I),ACI3(I),acim,ACV3(I),
& acvm,IPT3(I),TA3(I)
call edisp(itru,outs)
1255 CONTINUE
ENDIF
endif
RETURN
END
C ****************** CASINF
C CASINFO provides an English description of scheduled casual gains
C from zone operation common block data.
SUBROUTINE CASINF(ICOMP,ITRU)
#include "building.h"
COMMON/P1/oprdesc,ctlstr
COMMON/P3/NCAS1,ICGS1(MC),ICGF1(MC),CMGS1(MC),CMGL1(MC),
& RADC1(MC),CONC1(MC),NCAS2,ICGS2(MC),ICGF2(MC),CMGS2(MC),
& CMGL2(MC),RADC2(MC),CONC2(MC),NCAS3,ICGS3(MC),ICGF3(MC),
& CMGS3(MC),CMGL3(MC),RADC3(MC),CONC3(MC)
COMMON/P3TYPE/ICGT1(MC),ICGT2(MC),ICGT3(MC)
C Electrical data flag and elctrical data.
common/elecflg/ielf(mcom)
common/elp3/nel1,pf1(mc),ipf1(mc),pwr1(mc),bvolt1(mc),iphas1(mc),
& nel2,pf2(mc),ipf2(mc),pwr2(mc),bvolt2(mc),iphas2(mc),
& nel3,pf3(mc),ipf3(mc),pwr3(mc),bvolt3(mc),iphas3(mc)
C Descriptive label for a zone load or casual gain types.
common/loadlabel/lodlabel(mcom,7)
CHARACTER outs*124
CHARACTER oprdesc*248,ctlstr*24, lodlabel*6,llbl*9
call edisp(itru,' ')
call edisp(itru,'Notes: ')
call edisp248(itru,oprdesc,72)
IF(IELF(ICOMP).EQ.1) THEN
WRITE(outs,'(A,3I3)')' Number of Weekday Sat Sun zone loads=',
& NCAS1,NCAS2,NCAS3
ELSE
WRITE(outs,'(A,3I3)')' Number of Weekday Sat Sun casual gains=',
& NCAS1,NCAS2,NCAS3
ENDIF
call edisp(itru,outs)
if(NCAS1.eq.0.and.NCAS2.eq.0.and.NCAS3.eq.0)then
return
endif
if(IELF(ICOMP).EQ.1)then
write(outs,'(a,a)')'Day Gain Type Period Sensible ',
& 'Latent Radiant Convec p.f +/- Power Voltage Phase'
call edisp(itru,outs)
write(outs,'(a,a)')' No. labl Hours Magn.(W) ',
& 'Magn.(W) Frac Frac (-) (-) (W) (V) (rgb)'
call edisp(itru,outs)
else
write(outs,'(a,a)')'Day Gain Type Period Sensible ',
& 'Latent Radiant Convec'
call edisp(itru,outs)
write(outs,'(a,a)')' No. labl Hours Magn.(W) ',
& 'Magn. (W) Frac Frac'
call edisp(itru,outs)
endif
IF(NCAS1.GT.0)THEN
IF(IELF(ICOMP).EQ.1) THEN
DO 1269 I=1,NCAS1
if(ICGT1(I).gt.0)then
write(llbl,'(a,a)')lodlabel(ICOMP,ICGT1(I)),'W '
elseif(ICGT1(I).eq.-1)then
write(llbl,'(a,a)')lodlabel(ICOMP,iabs(ICGT1(I))),'m2p'
elseif(ICGT1(I).lt.-1)then
write(llbl,'(a,a)')lodlabel(ICOMP,iabs(ICGT1(I))),'Wm2'
endif
WRITE(outs,5361)'Wkd',I,llbl,ICGS1(I),' -',
& ICGF1(I),CMGS1(I),CMGL1(I),RADC1(I),CONC1(I),PF1(I),
& IPF1(I),PWR1(I),BVOLT1(I),IPHAS1(I)
5361 FORMAT(a,I3,1x,A9,I3,a,I3,F8.1,F8.1,F9.1,F9.1,
& 1x,F7.2,I3,F7.1,F7.1,I3)
call edisp(itru,outs)
1269 CONTINUE
ELSE
DO 1270 I=1,NCAS1
if(ICGT1(I).gt.0)then
write(llbl,'(a,a)')lodlabel(ICOMP,ICGT1(I)),'W '
elseif(ICGT1(I).eq.-1)then
write(llbl,'(a,a)')lodlabel(ICOMP,iabs(ICGT1(I))),'m2p'
elseif(ICGT1(I).lt.-1)then
write(llbl,'(a,a)')lodlabel(ICOMP,iabs(ICGT1(I))),'Wm2'
endif
WRITE(outs,5362)'Wkd',I,llbl,ICGS1(I),' -',
& ICGF1(I),CMGS1(I),CMGL1(I),RADC1(I),CONC1(I)
5362 FORMAT(a,I3,1x,A9,I3,a,I3,F9.1,F9.1,F11.2,F11.2)
call edisp(itru,outs)
1270 CONTINUE
ENDIF
ENDIF
IF(NCAS2.GT.0)THEN
IF(IELF(ICOMP).EQ.1) THEN
DO 1289 I=1,NCAS2
if(ICGT2(I).gt.0)then
write(llbl,'(a,a)')lodlabel(ICOMP,ICGT2(I)),'W '
elseif(ICGT2(I).eq.-1)then
write(llbl,'(a,a)')lodlabel(ICOMP,iabs(ICGT2(I))),'m2p'
elseif(ICGT2(I).lt.-1)then
write(llbl,'(a,a)')lodlabel(ICOMP,iabs(ICGT2(I))),'Wm2'
endif
WRITE(outs,5361)'Sat',I,llbl,ICGS2(I),' -',
& ICGF2(I),CMGS2(I),CMGL2(I),RADC2(I),CONC2(I),PF2(I),
& IPF2(I),PWR2(I),BVOLT2(I),IPHAS2(I)
call edisp(itru,outs)
1289 CONTINUE
ELSE
DO 1290 I=1,NCAS2
if(ICGT2(I).gt.0)then
write(llbl,'(a,a)')lodlabel(ICOMP,ICGT2(I)),'W '
elseif(ICGT2(I).eq.-1)then
write(llbl,'(a,a)')lodlabel(ICOMP,iabs(ICGT2(I))),'m2p'
elseif(ICGT2(I).lt.-1)then
write(llbl,'(a,a)')lodlabel(ICOMP,iabs(ICGT2(I))),'Wm2'
endif
WRITE(outs,5362)'Sat',I,llbl,ICGS2(I),' -',ICGF2(I),
& CMGS2(I),CMGL2(I),RADC2(I),CONC2(I)
call edisp(itru,outs)
1290 CONTINUE
ENDIF
ENDIF
IF(NCAS3.GT.0)THEN
IF(IELF(ICOMP).EQ.1) THEN
DO 1291 I=1,NCAS3
if(ICGT3(I).gt.0)then
write(llbl,'(a,a)')lodlabel(ICOMP,ICGT3(I)),'W '
elseif(ICGT3(I).eq.-1)then
write(llbl,'(a,a)')lodlabel(ICOMP,iabs(ICGT3(I))),'m2p'
elseif(ICGT3(I).lt.-1)then
write(llbl,'(a,a)')lodlabel(ICOMP,iabs(ICGT3(I))),'Wm2'
endif
WRITE(outs,5361)'Sun',I,llbl,ICGS3(I),' -',
& ICGF3(I),CMGS3(I),CMGL3(I),RADC3(I),CONC3(I),PF3(I),
& IPF3(I),PWR3(I),BVOLT3(I),IPHAS3(I)
call edisp(itru,outs)
1291 CONTINUE
ELSE
DO 1295 I=1,NCAS3
if(ICGT3(I).gt.0)then
write(llbl,'(a,a)')lodlabel(ICOMP,ICGT3(I)),'W '
elseif(ICGT3(I).eq.-1)then
write(llbl,'(a,a)')lodlabel(ICOMP,iabs(ICGT3(I))),'m2p'
elseif(ICGT3(I).lt.-1)then
write(llbl,'(a,a)')lodlabel(ICOMP,iabs(ICGT3(I))),'Wm2'
endif
WRITE(outs,5362)'Sun',I,llbl,ICGS3(I),' -',ICGF3(I),
1 CMGS3(I),CMGL3(I),RADC3(I),CONC3(I)
call edisp(itru,outs)
1295 CONTINUE
ENDIF
ENDIF
RETURN
END
C ************* checkcascount
C checkcascount scans current P3 & P3TYPE commons and refreshes
C loadcount() & load24() in common blocks loadcnt & loadall
C Parameters:
C icomp - current zone.
C ier - set to 1 if there was a problem
subroutine checkcascount(icomp,ier)
#include "building.h"
COMMON/OUTIN/IUOUT,IUIN
COMMON/P3/NCAS1,ICGS1(MC),ICGF1(MC),CMGS1(MC),CMGL1(MC),
&RADC1(MC),CONC1(MC),NCAS2,ICGS2(MC),ICGF2(MC),CMGS2(MC),
&CMGL2(MC),RADC2(MC),CONC2(MC),NCAS3,ICGS3(MC),ICGF3(MC),
&CMGS3(MC),CMGL3(MC),RADC3(MC),CONC3(MC)
COMMON/P3TYPE/ICGT1(MC),ICGT2(MC),ICGT3(MC)
C loadcount(zone,gaintype,daytype) - nb of each gain type (whether
C absolute or W/m2).
C loadm2count(zone,gaintype,daytype) - nb of each m2 gain types.
C Does each gain type on each day:
C start at zero load24(gaintype,daytype,1)=.true.
C and end at 24 hours (load24(gaintype,daytype,2)=.true.
common/loadcnt/loadcount(mcom,7,3),loadm2count(mcom,7,3)
common/loadall/load24(7,3,2)
logical load24
C Zero the loadcount array for the current zone.
ic=icomp
do 40 ij=1,7
loadcount(ic,ij,1)=0
loadcount(ic,ij,2)=0
loadcount(ic,ij,3)=0
loadm2count(ic,ij,1)=0
loadm2count(ic,ij,2)=0
loadm2count(ic,ij,3)=0
load24(ij,1,1)=.false.
load24(ij,2,1)=.false.
load24(ij,3,1)=.false.
load24(ij,1,2)=.false.
load24(ij,2,2)=.false.
load24(ij,3,2)=.false.
40 continue
C Debug..
C write(6,*) 'Nb of weekday/sat/sun periods for occ/lt/equip'
if(ncas1.gt.0)then
do 41 ij=1,ncas1
if(icgt1(ij).eq.1)then
loadcount(ic,1,1)=loadcount(ic,1,1)+1
if(ICGS1(ij).eq.0)load24(1,1,1)=.true.
if(ICGF1(ij).eq.24)load24(1,1,2)=.true.
elseif(icgt1(ij).eq.2)then
loadcount(ic,2,1)=loadcount(ic,2,1)+1
if(ICGS1(ij).eq.0)load24(2,1,1)=.true.
if(ICGF1(ij).eq.24)load24(2,1,2)=.true.
elseif(icgt1(ij).eq.3)then
loadcount(ic,3,1)=loadcount(ic,3,1)+1
if(ICGS1(ij).eq.0)load24(3,1,1)=.true.
if(ICGF1(ij).eq.24)load24(3,1,2)=.true.
elseif(icgt1(ij).eq.-1)then
loadcount(ic,1,1)=loadcount(ic,1,1)+1
loadm2count(ic,1,1)=loadm2count(ic,1,1)+1
if(ICGS1(ij).eq.0)load24(1,1,1)=.true.
if(ICGF1(ij).eq.24)load24(1,1,2)=.true.
elseif(icgt1(ij).eq.-2)then
loadcount(ic,2,1)=loadcount(ic,2,1)+1
loadm2count(ic,2,1)=loadm2count(ic,2,1)+1
if(ICGS1(ij).eq.0)load24(2,1,1)=.true.
if(ICGF1(ij).eq.24)load24(2,1,2)=.true.
elseif(icgt1(ij).eq.-3)then
loadcount(ic,3,1)=loadcount(ic,3,1)+1
loadm2count(ic,3,1)=loadm2count(ic,3,1)+1
if(ICGS1(ij).eq.0)load24(3,1,1)=.true.
if(ICGF1(ij).eq.24)load24(3,1,2)=.true.
endif
41 continue
endif
C Debug..
C write(6,*)loadcount(ic,1,1),loadcount(ic,2,1),loadcount(ic,3,1)
if(ncas2.gt.0)then
do 42 ij=1,ncas2
if(icgt2(ij).eq.1)then
loadcount(ic,1,2)=loadcount(ic,1,2)+1
if(ICGS2(ij).eq.0)load24(1,2,1)=.true.
if(ICGF2(ij).eq.24)load24(1,2,2)=.true.
elseif(icgt2(ij).eq.2)then
loadcount(ic,2,2)=loadcount(ic,2,2)+1
if(ICGS2(ij).eq.0)load24(2,2,1)=.true.
if(ICGF2(ij).eq.24)load24(2,2,2)=.true.
elseif(icgt2(ij).eq.3)then
loadcount(ic,3,2)=loadcount(ic,3,2)+1
if(ICGS2(ij).eq.0)load24(3,2,1)=.true.
if(ICGF2(ij).eq.24)load24(3,2,2)=.true.
elseif(icgt2(ij).eq.-1)then
loadcount(ic,1,2)=loadcount(ic,1,2)+1
loadm2count(ic,1,2)=loadm2count(ic,1,2)+1
if(ICGS2(ij).eq.0)load24(1,2,1)=.true.
if(ICGF2(ij).eq.24)load24(1,2,2)=.true.
elseif(icgt2(ij).eq.-2)then
loadcount(ic,2,2)=loadcount(ic,2,2)+1
loadm2count(ic,2,2)=loadm2count(ic,2,2)+1
if(ICGS2(ij).eq.0)load24(2,2,1)=.true.
if(ICGF2(ij).eq.24)load24(2,2,2)=.true.
elseif(icgt2(ij).eq.-3)then
loadcount(ic,3,2)=loadcount(ic,3,2)+1
loadm2count(ic,3,2)=loadm2count(ic,3,2)+1
if(ICGS2(ij).eq.0)load24(3,2,1)=.true.
if(ICGF2(ij).eq.24)load24(3,2,2)=.true.
endif
42 continue
endif
C Debug..
C write(6,*)loadcount(ic,1,2),loadcount(ic,2,2),loadcount(ic,3,2)
if(ncas3.gt.0)then
do 43 ij=1,ncas3
if(icgt3(ij).eq.1)then
loadcount(ic,1,3)=loadcount(ic,1,3)+1
if(ICGS3(ij).eq.0)load24(1,3,1)=.true.
if(ICGF3(ij).eq.24)load24(1,3,2)=.true.
elseif(icgt3(ij).eq.2)then
loadcount(ic,2,3)=loadcount(ic,2,3)+1
if(ICGS3(ij).eq.0)load24(2,3,1)=.true.
if(ICGF3(ij).eq.24)load24(2,3,2)=.true.
elseif(icgt3(ij).eq.3)then
loadcount(ic,3,3)=loadcount(ic,3,3)+1
if(ICGS3(ij).eq.0)load24(3,3,1)=.true.
if(ICGF3(ij).eq.24)load24(3,3,2)=.true.
elseif(icgt3(ij).eq.-1)then
loadcount(ic,1,3)=loadcount(ic,1,3)+1
loadm2count(ic,1,3)=loadm2count(ic,1,3)+1
if(ICGS3(ij).eq.0)load24(1,3,1)=.true.
if(ICGF3(ij).eq.24)load24(1,3,2)=.true.
elseif(icgt3(ij).eq.-2)then
loadcount(ic,2,3)=loadcount(ic,2,3)+1
loadm2count(ic,2,3)=loadm2count(ic,2,3)+1
if(ICGS3(ij).eq.0)load24(2,3,1)=.true.
if(ICGF3(ij).eq.24)load24(2,3,2)=.true.
elseif(icgt3(ij).eq.-3)then
loadcount(ic,3,3)=loadcount(ic,3,3)+1
loadm2count(ic,3,3)=loadm2count(ic,3,3)+1
if(ICGS3(ij).eq.0)load24(3,3,1)=.true.
if(ICGF3(ij).eq.24)load24(3,3,2)=.true.
endif
43 continue
endif
C Debug..
C write(6,*)loadcount(ic,1,3),loadcount(ic,2,3),loadcount(ic,3,3)
C write(6,*) load24
return
end
C ******************* CPYCASIJ ***********************
C CPYCASIJ Copy one casual period jx to another ix for zone icomp and
C daytype idaytype.
C icomp - current zone.
C idaytype - day type to sort
C ix is the destination
C jx is the source
SUBROUTINE CPYCASIJ(icomp,idaytype,ix,jx,ier)
#include "building.h"
COMMON/OUTIN/IUOUT,IUIN
COMMON/P3/NCAS1,ICGS1(MC),ICGF1(MC),CMGS1(MC),CMGL1(MC),
&RADC1(MC),CONC1(MC),NCAS2,ICGS2(MC),ICGF2(MC),CMGS2(MC),
&CMGL2(MC),RADC2(MC),CONC2(MC),NCAS3,ICGS3(MC),ICGF3(MC),
&CMGS3(MC),CMGL3(MC),RADC3(MC),CONC3(MC)
COMMON/P3TYPE/ICGT1(MC),ICGT2(MC),ICGT3(MC)
C Electrical data flag and elctrical data.
common/elecflg/ielf(mcom)
common/elp3/nel1,pf1(mc),ipf1(mc),pwr1(mc),bvolt1(mc),iphas1(mc),
& nel2,pf2(mc),ipf2(mc),pwr2(mc),bvolt2(mc),iphas2(mc),
& nel3,pf3(mc),ipf3(mc),pwr3(mc),bvolt3(mc),iphas3(mc)
if(idaytype.eq.1)then
ICGT1(ix)=ICGT1(jx)
ICGS1(ix)=ICGS1(jx)
ICGF1(ix)=ICGF1(jx)
CMGS1(ix)=CMGS1(jx)
CMGL1(ix)=CMGL1(jx)
RADC1(ix)=RADC1(jx)
CONC1(ix)=CONC1(jx)
if(ielf(icomp).ne.0)then
ipf1(ix)=ipf1(jx)
iphas1(ix)=iphas1(jx)
pf1(ix)=pf1(jx)
pwr1(ix)=pwr1(jx)
bvolt1(ix)=bvolt1(jx)
endif
elseif(idaytype.eq.2)then
ICGT2(ix)=ICGT2(jx)
ICGS2(ix)=ICGS2(jx)
ICGF2(ix)=ICGF2(jx)
CMGS2(ix)=CMGS2(jx)
CMGL2(ix)=CMGL2(jx)
RADC2(ix)=RADC2(jx)
CONC2(ix)=CONC2(jx)
if(ielf(icomp).ne.0)then
ipf2(ix)=ipf2(jx)
iphas2(ix)=iphas2(jx)
pf2(ix)=pf2(jx)
pwr2(ix)=pwr2(jx)
bvolt2(ix)=bvolt2(jx)
endif
elseif(idaytype.eq.3)then
ICGT3(ix)=ICGT3(jx)
ICGS3(ix)=ICGS3(jx)
ICGF3(ix)=ICGF3(jx)
CMGS3(ix)=CMGS3(jx)
CMGL3(ix)=CMGL3(jx)
RADC3(ix)=RADC3(jx)
CONC3(ix)=CONC3(jx)
if(ielf(icomp).ne.0)then
ipf3(ix)=ipf3(jx)
iphas3(ix)=iphas3(jx)
pf3(ix)=pf3(jx)
pwr3(ix)=pwr3(jx)
bvolt3(ix)=bvolt3(jx)
endif
endif
return
end
C ******************* CPYCASIT ***********************
C CPYCASIT Copy one casual period jx to backup variables for zone icomp
C and daytype idaytype.
C icomp - current zone.
C idaytype - day type to sort
C jx is the source
C icgt,icgs,icgf,cmgs,cmgl,radc,conc,ipf,iphas,pf,pwr,bvolt
C are the temporary variables.
SUBROUTINE CPYCASIT(icomp,idaytype,jx,icgt,icgs,icgf,cmgs,cmgl,
& radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
#include "building.h"
COMMON/OUTIN/IUOUT,IUIN
COMMON/P3/NCAS1,ICGS1(MC),ICGF1(MC),CMGS1(MC),CMGL1(MC),
&RADC1(MC),CONC1(MC),NCAS2,ICGS2(MC),ICGF2(MC),CMGS2(MC),
&CMGL2(MC),RADC2(MC),CONC2(MC),NCAS3,ICGS3(MC),ICGF3(MC),
&CMGS3(MC),CMGL3(MC),RADC3(MC),CONC3(MC)
COMMON/P3TYPE/ICGT1(MC),ICGT2(MC),ICGT3(MC)
C Electrical data flag and elctrical data.
common/elecflg/ielf(mcom)
common/elp3/nel1,pf1(mc),ipf1(mc),pwr1(mc),bvolt1(mc),iphas1(mc),
& nel2,pf2(mc),ipf2(mc),pwr2(mc),bvolt2(mc),iphas2(mc),
& nel3,pf3(mc),ipf3(mc),pwr3(mc),bvolt3(mc),iphas3(mc)
if(idaytype.eq.1)then
ICGT=ICGT1(jx)
ICGS=ICGS1(jx)
ICGF=ICGF1(jx)
CMGS=CMGS1(jx)
CMGL=CMGL1(jx)
RADC=RADC1(jx)
CONC=CONC1(jx)
if(ielf(icomp).ne.0)then
ipf=ipf1(jx)
iphas=iphas1(jx)
pf=pf1(jx)
pwr=pwr1(jx)
bvolt=bvolt1(jx)
else
ipf=0
iphas=1
pf=0.0
pwr=0.0
bvolt=0.0
endif
elseif(idaytype.eq.2)then
ICGT=ICGT2(jx)
ICGS=ICGS2(jx)
ICGF=ICGF2(jx)
CMGS=CMGS2(jx)
CMGL=CMGL2(jx)
RADC=RADC2(jx)
CONC=CONC2(jx)
if(ielf(icomp).ne.0)then
ipf=ipf2(jx)
iphas=iphas2(jx)
pf=pf2(jx)
pwr=pwr2(jx)
bvolt=bvolt2(jx)
else
ipf=0
iphas=1
pf=0.0
pwr=0.0
bvolt=0.0
endif
elseif(idaytype.eq.3)then
ICGT=ICGT3(jx)
ICGS=ICGS3(jx)
ICGF=ICGF3(jx)
CMGS=CMGS3(jx)
CMGL=CMGL3(jx)
RADC=RADC3(jx)
CONC=CONC3(jx)
if(ielf(icomp).ne.0)then
ipf=ipf3(jx)
iphas=iphas3(jx)
pf=pf3(jx)
pwr=pwr3(jx)
bvolt=bvolt3(jx)
else
ipf=0
iphas=1
pf=0.0
pwr=0.0
bvolt=0.0
endif
endif
return
end
C ******************* CPYCASTI ***********************
C CPYCASTI - Copy from backup variables to casual period jx for zone icomp
C and daytype idaytype.
C icomp - current zone.
C idaytype - day type to sort
C jx is the destination
C icgt,icgs,icgf,cmgs,cmgl,radc,conc,ipf,iphas,pf,pwr,bvolt
C are the temporary variables.
SUBROUTINE CPYCASTI(icomp,idaytype,jx,icgt,icgs,icgf,cmgs,cmgl,
& radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
#include "building.h"
COMMON/OUTIN/IUOUT,IUIN
COMMON/P3/NCAS1,ICGS1(MC),ICGF1(MC),CMGS1(MC),CMGL1(MC),
&RADC1(MC),CONC1(MC),NCAS2,ICGS2(MC),ICGF2(MC),CMGS2(MC),
&CMGL2(MC),RADC2(MC),CONC2(MC),NCAS3,ICGS3(MC),ICGF3(MC),
&CMGS3(MC),CMGL3(MC),RADC3(MC),CONC3(MC)
COMMON/P3TYPE/ICGT1(MC),ICGT2(MC),ICGT3(MC)
C Electrical data flag and elctrical data.
common/elecflg/ielf(mcom)
common/elp3/nel1,pf1(mc),ipf1(mc),pwr1(mc),bvolt1(mc),iphas1(mc),
& nel2,pf2(mc),ipf2(mc),pwr2(mc),bvolt2(mc),iphas2(mc),
& nel3,pf3(mc),ipf3(mc),pwr3(mc),bvolt3(mc),iphas3(mc)
if(idaytype.eq.1)then
ICGT1(jx)=ICGT
ICGS1(jx)=ICGS
ICGF1(jx)=ICGF
CMGS1(jx)=CMGS
CMGL1(jx)=CMGL
RADC1(jx)=RADC
CONC1(jx)=CONC
if(ielf(icomp).ne.0)then
ipf1(jx)=ipf
iphas1(jx)=iphas
pf1(jx)=pf
pwr1(jx)=pwr
bvolt1(jx)=bvolt
else
ipf1(jx)=0
iphas1(jx)=1
pf1(jx)=0.0
pwr1(jx)=0.0
bvolt1(jx)=0.0
endif
elseif(idaytype.eq.2)then
ICGT2(jx)=ICGT
ICGS2(jx)=ICGS
ICGF2(jx)=ICGF
CMGS2(jx)=CMGS
CMGL2(jx)=CMGL
RADC2(jx)=RADC
CONC2(jx)=CONC
if(ielf(icomp).ne.0)then
ipf2(jx)=ipf
iphas2(jx)=iphas
pf2(jx)=pf
pwr2(jx)=pwr
bvolt2(jx)=bvolt
else
ipf2(jx)=0
iphas2(jx)=1
pf2(jx)=0.0
pwr2(jx)=0.0
bvolt2(jx)=0.0
endif
elseif(idaytype.eq.3)then
ICGT3(jx)=ICGT
ICGS3(jx)=ICGS
ICGF3(jx)=ICGF
CMGS3(jx)=CMGS
CMGL3(jx)=CMGL
RADC3(jx)=RADC
CONC3(jx)=CONC
if(ielf(icomp).ne.0)then
ipf3(jx)=ipf
iphas3(jx)=iphas
pf3(jx)=pf
pwr3(jx)=pwr
bvolt3(jx)=bvolt
else
ipf3(jx)=0
iphas3(jx)=1
pf3(jx)=0.0
pwr3(jx)=0.0
bvolt3(jx)=0.0
endif
endif
return
end
C ******************* SORTCAS ***********************
C SORTCAS Sort an array of casual gains by casual gain type and then by
C starting time. A slightly modified QUICKSORT algorithm is used.
C icomp - current zone.
C idaytype - day type to sort
C N - number of values to be sorted
C Logic similar to sorti but a 2nd pass is made to ensure that
C the start times ascend within each type.
SUBROUTINE SORTCAS(icomp,idaytype,ier)
#include "building.h"
COMMON/OUTIN/IUOUT,IUIN
COMMON/P3/NCAS1,ICGS1(MC),ICGF1(MC),CMGS1(MC),CMGL1(MC),
&RADC1(MC),CONC1(MC),NCAS2,ICGS2(MC),ICGF2(MC),CMGS2(MC),
&CMGL2(MC),RADC2(MC),CONC2(MC),NCAS3,ICGS3(MC),ICGF3(MC),
&CMGS3(MC),CMGL3(MC),RADC3(MC),CONC3(MC)
COMMON/P3TYPE/ICGT1(MC),ICGT2(MC),ICGT3(MC)
common/elecflg/ielf(mcom)
common/elp3/nel1,pf1(mc),ipf1(mc),pwr1(mc),bvolt1(mc),iphas1(mc),
& nel2,pf2(mc),ipf2(mc),pwr2(mc),bvolt2(mc),iphas2(mc),
& nel3,pf3(mc),ipf3(mc),pwr3(mc),bvolt3(mc),iphas3(mc)
C How many of each gain type is there each zone/gaintype/daytype.
common/loadcnt/loadcount(mcom,7,3),loadm2count(mcom,7,3)
INTEGER T, TT
integer icgt,icgs,icgf,ipf,iphas,icgtt,icgstt,icgftt,ipftt,iphastt
real cmgs,cmgl,radc,conc,pf,pwr,bvolt
real cmgstt,cmgltt,radctt,conctt,pftt,pwrtt,bvoltt
DIMENSION IL(MC), IU(MC)
C Temporary array.
dimension ICGSA(MC),ICGFA(MC),CMGSA(MC),CMGLA(MC),RADCA(MC)
dimension CONCA(MC),ICGTA(MC)
dimension pfA(mc),ipfA(mc),pwrA(mc),bvoltA(mc),iphasA(mc)
C Set loop limits for current day type.
if(idaytype.eq.1)then
ncas=ncas1
elseif(idaytype.eq.2)then
ncas=ncas2
elseif(idaytype.eq.3)then
ncas=ncas3
endif
NN=ncas
if (NN.le.1) RETURN
C First pass looking at casual gain type.
ipass=1
C Sort casual gain type and carry other data along.
100 M=1
I=1
J=NN
R=0.375E0
110 if (I .EQ. J) GO TO 150
if (R.le.0.5898437E0) then
R=R+3.90625E-2
else
R=R-0.21875E0
endif
120 K=I
C Select a central element of the array and save it in location T.
C If first pass use casual gain type, if 2nd pass use start time.
IJ=I + INT((J-I)*R)
if(idaytype.eq.1)then
T=ICGS1(IJ)
elseif(idaytype.eq.2)then
T=ICGS2(IJ)
elseif(idaytype.eq.3)then
T=ICGS3(IJ)
endif
C Remember associated data.
call CPYCASIT(icomp,idaytype,ij,icgt,icgs,icgf,cmgs,cmgl,
& radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
C TY=IY(IJ)
C If first element of array is greater than T, interchange with T.
if(idaytype.eq.1)then
if(ICGS1(I).GT. T) then
call CPYCASIJ(icomp,idaytype,ij,i,ier)
call CPYCASTI(icomp,idaytype,i,icgt,icgs,icgf,cmgs,cmgl,
& radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
ICGS1(I)=T
call CPYCASIT(icomp,idaytype,ij,icgt,icgs,icgf,cmgs,cmgl,
& radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
T=ICGS1(IJ)
endif
elseif(idaytype.eq.2)then
if(ICGS2(I).GT. T) then
call CPYCASIJ(icomp,idaytype,ij,i,ier)
call CPYCASTI(icomp,idaytype,i,icgt,icgs,icgf,cmgs,cmgl,
& radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
ICGS2(I)=T
call CPYCASIT(icomp,idaytype,ij,icgt,icgs,icgf,cmgs,cmgl,
& radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
T=ICGS2(IJ)
endif
elseif(idaytype.eq.3)then
if(ICGS3(I).GT. T) then
call CPYCASIJ(icomp,idaytype,ij,i,ier)
call CPYCASTI(icomp,idaytype,i,icgt,icgs,icgf,cmgs,cmgl,
& radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
ICGS3(I)=T
call CPYCASIT(icomp,idaytype,ij,icgt,icgs,icgf,cmgs,cmgl,
& radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
T=ICGS3(IJ)
endif
endif
C if (IX(I) .GT. T) then
C IX(IJ)=IX(I)
C IX(I)=T
C T=IX(IJ)
C IY(IJ)=IY(I)
C IY(I)=TY
C TY=IY(IJ)
C endif
L=J
C If last element of array is less than T, interchange with T.
C if (IX(J) .LT. T) then
if(idaytype.eq.1)then
if(ICGS1(J).LT. T) then
call CPYCASIJ(icomp,idaytype,ij,j,ier)
call CPYCASTI(icomp,idaytype,j,icgt,icgs,icgf,cmgs,cmgl,
& radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
ICGS1(j)=T
call CPYCASIT(icomp,idaytype,ij,icgt,icgs,icgf,cmgs,cmgl,
& radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
T=ICGS1(IJ)
C If first element of array is greater than T, interchange with T.
if(ICGS1(I).GT. T) then
call CPYCASIJ(icomp,idaytype,ij,i,ier)
call CPYCASTI(icomp,idaytype,i,icgt,icgs,icgf,cmgs,
& cmgl,radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
ICGS1(I)=T
call CPYCASIT(icomp,idaytype,ij,icgt,icgs,icgf,cmgs,
& cmgl,radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
T=ICGS1(IJ)
endif
endif
elseif(idaytype.eq.2)then
if(ICGS2(J).LT. T) then
call CPYCASIJ(icomp,idaytype,ij,j,ier)
call CPYCASTI(icomp,idaytype,j,icgt,icgs,icgf,cmgs,cmgl,
& radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
ICGS2(j)=T
call CPYCASIT(icomp,idaytype,ij,icgt,icgs,icgf,cmgs,cmgl,
& radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
T=ICGS2(IJ)
C If first element of array is greater than T, interchange with T.
if(ICGS2(I).GT. T) then
call CPYCASIJ(icomp,idaytype,ij,i,ier)
call CPYCASTI(icomp,idaytype,i,icgt,icgs,icgf,cmgs,
& cmgl,radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
ICGS2(I)=T
call CPYCASIT(icomp,idaytype,ij,icgt,icgs,icgf,cmgs,
& cmgl,radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
T=ICGS2(IJ)
endif
endif
elseif(idaytype.eq.3)then
if(ICGS3(J).LT. T) then
call CPYCASIJ(icomp,idaytype,ij,j,ier)
call CPYCASTI(icomp,idaytype,j,icgt,icgs,icgf,cmgs,cmgl,
& radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
ICGS3(j)=T
call CPYCASIT(icomp,idaytype,ij,icgt,icgs,icgf,cmgs,cmgl,
& radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
T=ICGS3(IJ)
C If first element of array is greater than T, interchange with T.
if(ICGS3(I).GT. T) then
call CPYCASIJ(icomp,idaytype,ij,i,ier)
call CPYCASTI(icomp,idaytype,i,icgt,icgs,icgf,cmgs,
& cmgl,radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
ICGS3(I)=T
call CPYCASIT(icomp,idaytype,ij,icgt,icgs,icgf,cmgs,
& cmgl,radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
T=ICGS3(IJ)
endif
endif
endif
C IX(IJ)=IX(J)
C IX(J)=T
C T=IX(IJ)
C IY(IJ)=IY(J)
C IY(J)=TY
C TY=IY(IJ)
C If first element of array is greater than T, interchange with T.
C if (IX(I) .GT. T) then
C IX(IJ)=IX(I)
C IX(I)=T
C T=IX(IJ)
C IY(IJ)=IY(I)
C IY(I)=TY
C TY=IY(IJ)
C endif
C endif
C Find an element in the second half of the array which is smaller
C than T.
130 L=L-1
if(idaytype.eq.1)then
if(ICGS1(L).GT. T) goto 130
elseif(idaytype.eq.2)then
if(ICGS2(L).GT. T) goto 130
elseif(idaytype.eq.3)then
if(ICGS3(L).GT. T) goto 130
endif
C if (IX(L) .GT. T) GO TO 130
C Find an element in the first half of the array which is greater
C than T.
140 K=K+1
if(idaytype.eq.1)then
if(ICGS1(K).LT. T) goto 140
elseif(idaytype.eq.2)then
if(ICGS2(K).LT. T) goto 140
elseif(idaytype.eq.3)then
if(ICGS3(K).LT. T) goto 140
endif
C if (IX(K) .LT. T) GO TO 140
C Interchange these elements.
if (K.le.L) then
if(idaytype.eq.1)then
call CPYCASIT(icomp,idaytype,L,icgtt,icgstt,icgftt,cmgstt,
& cmgltt,radctt,conctt,ipftt,iphastt,pftt,pwrtt,bvoltt,ier)
TT=ICGS1(L)
call CPYCASIJ(icomp,idaytype,L,K,ier)
call CPYCASTI(icomp,idaytype,K,icgtt,icgstt,icgftt,cmgstt,
& cmgltt,radctt,conctt,ipftt,iphastt,pftt,pwrtt,bvoltt,ier)
ICGS1(K)=TT
elseif(idaytype.eq.2)then
call CPYCASIT(icomp,idaytype,L,icgtt,icgstt,icgftt,cmgstt,
& cmgltt,radctt,conctt,ipftt,iphastt,pftt,pwrtt,bvoltt,ier)
TT=ICGS2(L)
call CPYCASIJ(icomp,idaytype,L,K,ier)
call CPYCASTI(icomp,idaytype,K,icgtt,icgstt,icgftt,cmgstt,
& cmgltt,radctt,conctt,ipftt,iphastt,pftt,pwrtt,bvoltt,ier)
ICGS2(K)=TT
elseif(idaytype.eq.3)then
call CPYCASIT(icomp,idaytype,L,icgtt,icgstt,icgftt,cmgstt,
& cmgltt,radctt,conctt,ipftt,iphastt,pftt,pwrtt,bvoltt,ier)
TT=ICGS3(L)
call CPYCASIJ(icomp,idaytype,L,K,ier)
call CPYCASTI(icomp,idaytype,K,icgtt,icgstt,icgftt,cmgstt,
& cmgltt,radctt,conctt,ipftt,iphastt,pftt,pwrtt,bvoltt,ier)
ICGS3(K)=TT
endif
GO TO 130
endif
C TT=IX(L)
C IX(L)=IX(K)
C IX(K)=TT
C TTY=IY(L)
C IY(L)=IY(K)
C IY(K)=TTY
C GO TO 130
C endif
C Save upper and lower subscripts of the array yet to be sorted.
if (L-I .GT. J-K) then
IL(M)=I
IU(M)=L
I=K
M=M+1
ELSE
IL(M)=K
IU(M)=J
J=L
M=M+1
endif
GO TO 160
C Begin again on another portion of the unsorted array.
150 M=M-1
if (M .EQ. 0) GO TO 190
I=IL(M)
J=IU(M)
160 if (J-I .GE. 1) GO TO 120
if (I .EQ. 1) GO TO 110
I=I-1
170 I=I+1
if (I .EQ. J) GO TO 150
if(idaytype.eq.1)then
call CPYCASIT(icomp,idaytype,i+1,icgt,icgs,icgf,cmgs,
& cmgl,radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
T=ICGS1(I+1)
elseif(idaytype.eq.2)then
call CPYCASIT(icomp,idaytype,i+1,icgt,icgs,icgf,cmgs,
& cmgl,radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
T=ICGS2(I+1)
elseif(idaytype.eq.3)then
call CPYCASIT(icomp,idaytype,i+1,icgt,icgs,icgf,cmgs,
& cmgl,radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
T=ICGS3(I+1)
endif
C T=IX(I+1)
C TY=IY(I+1)
if(idaytype.eq.1)then
if(ICGS1(I).le. T) goto 170
elseif(idaytype.eq.2)then
if(ICGS2(I).le. T) goto 170
elseif(idaytype.eq.3)then
if(ICGS3(I).le. T) goto 170
endif
C if (IX(I).le.T) GO TO 170
K=I
180 continue
if(idaytype.eq.1)then
call CPYCASIJ(icomp,idaytype,K+1,K,ier)
elseif(idaytype.eq.2)then
call CPYCASIJ(icomp,idaytype,K+1,K,ier)
elseif(idaytype.eq.3)then
call CPYCASIJ(icomp,idaytype,K+1,K,ier)
endif
K=K-1
C 180 IX(K+1)=IX(K)
C IY(K+1)=IY(K)
C K=K-1
if(idaytype.eq.1)then
if(T.LT.ICGS1(K)) goto 180
elseif(idaytype.eq.2)then
if(T.LT.ICGS2(K)) goto 180
elseif(idaytype.eq.3)then
if(T.LT.ICGS3(K)) goto 180
endif
C if (T .LT. IX(K)) GO TO 180
if(idaytype.eq.1)then
call CPYCASTI(icomp,idaytype,K+1,icgt,icgs,icgf,cmgs,
& cmgl,radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
ICGS1(K+1)=T
elseif(idaytype.eq.2)then
call CPYCASTI(icomp,idaytype,K+1,icgt,icgs,icgf,cmgs,
& cmgl,radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
ICGS2(K+1)=T
elseif(idaytype.eq.3)then
call CPYCASTI(icomp,idaytype,K+1,icgt,icgs,icgf,cmgs,
& cmgl,radc,conc,ipf,iphas,pf,pwr,bvolt,ier)
ICGS3(K+1)=T
endif
C IX(K+1)=T
C IY(K+1)=TY
GO TO 170
C Clean up.
190 continue
C Display modified gain profiles.
call CASINF(ICOMP,iuout)
C Check how many casual gains there are for each type on each day type.
call checkcascount(icomp,ier)
C So all gains for this day type have been sorted by time.
C Now loop through and write to a 2nd array by casual gain
C type and then copy back into the standard arrays.
C n1t,n2t,n3t increment position where each type of casual gain is written.
iip=0
if(idaytype.eq.1)then
C Loop for each weekely casual gain type and write to the
C appropriate slot in the temporary array..
n1=loadcount(icomp,1,1)
n2=loadcount(icomp,2,1)
n3=loadcount(icomp,3,1)
n1t=0
n2t=n1
n3t=n1+n2
iip=0
do 27,ii=1,ncas1
if(ICGT1(ii).eq.1.or.ICGT1(ii).eq.-1)then
n1t=n1t+1
iip=n1t
elseif(ICGT1(ii).eq.2.or.ICGT1(ii).eq.-2)then
n2t=n2t+1
iip=n2t
elseif(ICGT1(ii).eq.3.or.ICGT1(ii).eq.-3)then
n3t=n3t+1
iip=n3t
endif
ICGTA(iip)=ICGT1(ii)
ICGSA(iip)=ICGS1(ii)
ICGFA(iip)=ICGF1(ii)
CMGSA(iip)=CMGS1(ii)
CMGLA(iip)=CMGL1(ii)
RADCA(iip)=RADC1(ii)
CONCA(iip)=CONC1(ii)
if(ielf(icomp).ne.0)then
ipfA(iip)=ipf1(ii)
iphasA(iip)=iphas1(ii)
pfA(iip)=pf1(ii)
pwrA(iip)=pwr1(ii)
bvoltA(iip)=bvolt1(ii)
endif
27 continue
elseif(idaytype.eq.2)then
n1=loadcount(icomp,1,2)
n2=loadcount(icomp,2,2)
n3=loadcount(icomp,3,2)
n1t=0
n2t=n1
n3t=n1+n2
iip=0
do 28,ii=1,ncas2
if(ICGT2(ii).eq.1.or.ICGT2(ii).eq.-1)then
n1t=n1t+1
iip=n1t
elseif(ICGT2(ii).eq.2.or.ICGT2(ii).eq.-2)then
n2t=n2t+1
iip=n2t
elseif(ICGT2(ii).eq.3.or.ICGT2(ii).eq.-3)then
n3t=n3t+1
iip=n3t
endif
ICGTA(iip)=ICGT2(ii)
ICGSA(iip)=ICGS2(ii)
ICGFA(iip)=ICGF2(ii)
CMGSA(iip)=CMGS2(ii)
CMGLA(iip)=CMGL2(ii)
RADCA(iip)=RADC2(ii)
CONCA(iip)=CONC2(ii)
if(ielf(icomp).ne.0)then
ipfA(iip)=ipf2(ii)
iphasA(iip)=iphas2(ii)
pfA(iip)=pf2(ii)
pwrA(iip)=pwr2(ii)
bvoltA(iip)=bvolt2(ii)
endif
28 continue
elseif(idaytype.eq.3)then
n1=loadcount(icomp,1,3)
n2=loadcount(icomp,2,3)
n3=loadcount(icomp,3,3)
n1t=0
n2t=n1
n3t=n1+n2
iip=0
do 29,ii=1,ncas3
if(ICGT3(ii).eq.1.or.ICGT3(ii).eq.-1)then
n1t=n1t+1
iip=n1t
elseif(ICGT3(ii).eq.2.or.ICGT3(ii).eq.-2)then
n2t=n2t+1
iip=n2t
elseif(ICGT3(ii).eq.3.or.ICGT3(ii).eq.-3)then
n3t=n3t+1
iip=n3t
endif
ICGTA(iip)=ICGT3(ii)
ICGSA(iip)=ICGS3(ii)
ICGFA(iip)=ICGF3(ii)
CMGSA(iip)=CMGS3(ii)
CMGLA(iip)=CMGL3(ii)
RADCA(iip)=RADC3(ii)
CONCA(iip)=CONC3(ii)
if(ielf(icomp).ne.0)then
ipfA(iip)=ipf3(ii)
iphasA(iip)=iphas3(ii)
pfA(iip)=pf3(ii)
pwrA(iip)=pwr3(ii)
bvoltA(iip)=bvolt3(ii)
endif
29 continue
endif
C Now write from the temporary array to back to the normal array.
if(idaytype.eq.1)then
do 127,ii=1,ncas1
ICGT1(ii)=ICGTA(ii)
ICGS1(ii)=ICGSA(ii)
ICGF1(ii)=ICGFA(ii)
CMGS1(ii)=CMGSA(ii)
CMGL1(ii)=CMGLA(ii)
RADC1(ii)=RADCA(ii)
CONC1(ii)=CONCA(ii)
if(ielf(icomp).ne.0)then
ipf1(ii)=ipfA(ii)
iphas1(ii)=iphasA(ii)
pf1(ii)=pfA(ii)
pwr1(ii)=pwrA(ii)
bvolt1(ii)=bvoltA(ii)
endif
127 continue
elseif(idaytype.eq.2)then
do 128,ii=1,ncas2
ICGT2(ii)=ICGTA(ii)
ICGS2(ii)=ICGSA(ii)
ICGF2(ii)=ICGFA(ii)
CMGS2(ii)=CMGSA(ii)
CMGL2(ii)=CMGLA(ii)
RADC2(ii)=RADCA(ii)
CONC2(ii)=CONCA(ii)
if(ielf(icomp).ne.0)then
ipf2(ii)=ipfA(ii)
iphas2(ii)=iphasA(ii)
pf2(ii)=pfA(ii)
pwr2(ii)=pwrA(ii)
bvolt2(ii)=bvoltA(ii)
endif
128 continue
elseif(idaytype.eq.3)then
do 129,ii=1,ncas3
ICGT3(ii)=ICGTA(ii)
ICGS3(ii)=ICGSA(ii)
ICGF3(ii)=ICGFA(ii)
CMGS3(ii)=CMGSA(ii)
CMGL3(ii)=CMGLA(ii)
RADC3(ii)=RADCA(ii)
CONC3(ii)=CONCA(ii)
if(ielf(icomp).ne.0)then
ipf3(ii)=ipfA(ii)
iphas3(ii)=iphasA(ii)
pf3(ii)=pfA(ii)
pwr3(ii)=pwrA(ii)
bvolt3(ii)=bvoltA(ii)
endif
129 continue
endif
C Display modified gain profiles.
call CASINF(ICOMP,iuout)
return
END