The World of Computer Software/World_Of_Computer_Software-02-387-Vol-3of3.iso/h/house_ii.zip/FOR/FLOOR.FOR

Text File | 1992-05-08 | 6KB | 189 lines

      SUBROUTINE FLOOR(NRM,IZW,ID,KON,NZONC,TZONC,DCTFLR,IDBG)
C
C  FLOOR TEMPERATURES WITH OR WITHOUT DUCTS BELOW
C
C - - - PARAMETER COMMON BLOCKS
C
CMDK FTR
CMDK NKONST
CMDK NWL
CMDK NWN
CMDK NZN
CMDK NZW
CMDK SIGMA
C - - - COMMON BLOCKS
CMDK BLKBSF
CMDK BLKQS
CMDK CNSTRK
CMDK DUCTS2
CMDK ENCBK1
CMDK ENCBK2
CMDK ENCBLK
CMDK IZPART
CMDK IZWQ
CMDK MRTBLK
CMDK SOILB
CMDK SURFAR
CMDK TCNBLK
CMDK TEMPB
CMDK TIMEB
CMDK UABAS
      DATA NQTM/0/
      IF(NQTM.EQ.0.AND.IGRND.GT.0)THEN
C              INITIALIZE BSMT FLOOR TEMPS (IN STRDAY, IF IGRND=0)
        NQTM=1
C         ASSUME HEAT FLOW IS SAME FOR EA, SO USE IZW BELOW
        QSURF=QCSURF(IZW)/AWALLA(IZW)
        DO 2 I=1,2
        IZ=IZWD(I)
C         BASEMENT FLOOR NODES WITH PRECONDITIONING
        KONF=KONSTA(IZ)
        NLM=NLMP(KONF)
        ISOIL=5
        IF(I.EQ.2)ISOIL=11
        TWI=TBASM-5.
        CALL TWISET(7,QSURF,TBASM,TWI)
        TMID=0.5*(TSOIL(ISOIL)+TWI)
        TMP(1,IZ)=TSOIL(ISOIL)
        TMP(2,IZ)=TMID
        TMP(3,IZ)=TWI
        IF(NLM.NE.1)THEN
          TMP(4,IZ)=TWI
          TMP(3,IZ)=TMID+0.5*(TWI-TMID)
        ENDIF
    2   CONTINUE
      ENDIF
C  AFLOOR IS ENTIRE FLOOR AREA IN THIS ZONE (FROM CONSLD)
      AFLOOR=AFLRT(NRM)
      QDCTB=QDCTBA(NRM)
      K=KON
      NLM=NLMP(K)
      DQDUCT=0.
      IF(NZONC.EQ.7.OR.NZONC.EQ.8)THEN
          DQDUCT=QDCTB*DCTFLR/AWALLA(IZW)
          ENDIF
      T1=TMP(1,IZW)
      T2=TMP(2,IZW)
      T3=TMP(3,IZW)
      IF(NLM.EQ.3)T4=TMP(4,IZW)
      TC1=TCON(1,K)
      TC2=TCON(2,K)
      TC3=TCON(3,K)
      IF(NLM.EQ.3)THEN
        TC4=TCON(4,K)
        TC5=TCON(5,K)
        TC6=TCON(6,K)
        TC7=TCON(7,K)
        TC8=TCON(8,K)
      ENDIF
      IF(ID.EQ.8)THEN
C        **  BASEMENT FLOOR
        IHIT=0
        DO 20 I=1,2
C   IZWD VALUES ARE SET IN CONSLD ABOVE LABEL 134
        IF(IZWD(I).EQ.IZW)THEN
          IHIT=1
          ISOIL=5
          IJ=15
          IF(I.EQ.2)THEN
            ISOIL=11
            IJ=27
          ENDIF
C            ICODE IS SET IN HOUS_II
          IF(IGRND.EQ.0.OR.ICODE.EQ.1.OR.ICODE.EQ.4)THEN
            TMPN(1,IZW)=TSOIL(ISOIL)
C  NOTE: QLOSFL WILL NOT INCLUDE HEAT LOSS TO SOIL WITH IGRND=0!
          ELSE
            QLOSF=CONDWL(I+4)*(TG(IJ)-T1)
            TMPN(1,IZW)=TC1*(T2-T1)+TC2*QLOSF+T1
            QLOSFL(NRM)=QLOSFL(NRM)-QLOSF*AWALLA(IZW)
          ENDIF
        ENDIF
   20   CONTINUE
        IF(IHIT.EQ.0)STOP 'FLOOR: ID MUST BE ONE OF IZWD() IF ID=8!'
      ELSE
C        **  LIVING SPACE FLOOR WITH BASEMENT OR CRAWL SPC BELOW
        IF(NZONC.EQ.3.OR.NZONC.EQ.8)THEN
C                        CRAWLSPACE !! MUST CALC CONVECTIVE Q
          H1FCRW=HC(NRM,IZW,2,.FALSE.,T1,TZONC)
          QCSRF=H1FCRW*AWALLA(IZW)*(TZONC-T1)
          QPRADO=WALLFO(IZW)*SIGMA*((TZONC+FTR)**4-(T1+FTR)**4)
        ELSE
          IZWO=IZSET(IZW)
          QCSRF=QCSURF(IZW)
          QPRADO=HRI(IZWO)*(TMR(NZNBAS)-T1)
        ENDIF
        TMPN(1,IZW)=TC3*(T2-T1)+TC2*(QCSRF/AWALLA(IZW)+DQDUCT
     +                +QPRADO)+T1
      ENDIF
      IF(NLM.EQ.1)THEN
        TMPN(2,IZW)=0.5*TC1*(T1-2.*T2+T3)+T2
        IF(ICODE.EQ.1.OR.ICODE.EQ.4)THEN
          QSURF=QCSURF(IZW)/AWALLA(IZW)
          TWI=T3
          CALL TWISET(7,QSURF,TBASM,TWI)
          TMPN(3,IZW)=TWI
        ELSE
          QPRADI=HRI(IZW)*(TMR(NRM)-T3)+QSI(IZW)
          QSURF=QCSURF(IZW)/AWALLA(IZW) + QPRADI
          TMPN(3,IZW)=TC3*(T2-T3)+TC2*QSURF+T3
        ENDIF
      ELSE
        TMPN(2,IZW)=TC3*(T1-T2)+TC4*(T3-T2)+T2
        TMPN(3,IZW)=TC5*(T2-T3)+TC6*(T4-T3)+T3
        IF(ICODE.EQ.1.OR.ICODE.EQ.4)THEN
          QSURF=QCSURF(IZW)/AWALLA(IZW)
          TWI=T4
          CALL TWISET(7,QSURF,TBASM,TWI)
          TMPN(4,IZW)=TWI
        ELSE
          QPRADI=HRI(IZW)*(TMR(NRM)-T4)+QSI(IZW)
          QSURF=QCSURF(IZW)/AWALLA(IZW) + QPRADI
          TMPN(4,IZW)=TC7*(T3-T4)+TC8*QSURF+T4
        ENDIF
      ENDIF
      IF(NZONC.EQ.3.OR.NZONC.EQ.8.OR.ICODE.EQ.1.OR.ICODE.EQ.4)GO TO 30
      QRMRT(IZWO)=QPRADO*AWALLA(IZW)
   30 QRMRT(IZW)=QPRADI*AWALLA(IZW)
      IF(IDBG.NE.0)THEN
          WRITE(60,500)NRM,IZW,ID,KON,NZONC,TZONC,
     +                     QDCTBA,DCTFLR
      IF(NLM.EQ.1)THEN
          WRITE(60,501)AFLOOR,     DQDUCT,
     +    T1,TMPN(1,IZW),T2,TMPN(2,IZW),T3,TMPN(3,IZW),
     +    TC1,TC2,TC3
      ELSE
          WRITE(60,503)AFLOOR,     DQDUCT,
     +    T1,TMPN(1,IZW),T2,TMPN(2,IZW),T3,TMPN(3,IZW),
     +    T4,TMPN(4,IZW),TC1,TC2,TC3,TC4,TC5,TC6,TC7,TC8
          ENDIF
      IF(ID.EQ.8)WRITE(60,502)QCSURF(IZW),QRMRT(IZW),TMR(NRM),
     +                       QSI(IZW)
      IF(ID.NE.8)WRITE(60,504)QCSURF(IZWO),QRMRT(IZWO),QRMRT(IZW),
     +                       TMR(NZNBAS),TMR(NRM),QSI(IZW)
          ENDIF
      RETURN
  500 FORMAT(25X,'FLOOR:NRM,IZW,ID,KON,NZONC= ',5I5/
     +25X,'TZONC= ',G13.5/
     +25X,'DCTFLR,QDCTBA(I)= ',6G13.5)
  501 FORMAT(25X,'AFLOOR,DQDUCT= ',2G13.5/
     +25X,'T1,T1N= ',2G13.5/
     +25X,'T2,T2N= ',2G13.5/
     +25X,'T3,T3N= ',2G13.5/
     +25X,'TC1,TC2,TC3= ',3G13.5)
  502 FORMAT(25X,'QCSURF,QRMRT,HRI,TMR,QSI= ',5G13.5)
  503 FORMAT(25X,'AFLOOR,DQDUCT= ',2G13.5/
     +25X,'T1,T1N= ',2G13.5/
     +25X,'T2,T2N= ',2G13.5/
     +25X,'T3,T3N= ',2G13.5/
     +25X,'T4,T4N= ',2G13.5/
     +25X,'TC1,TC2,TC3,TC4= ',4G13.5/
     +25X,'TC5,TC6,TC7,TC8= ',4G13.5)
  504 FORMAT(25X,'QCSURF AND QRMRT FOR IZWO= ',2G13.5/
     +25X,'QCSURF AND QRMRT FOR IZW= ',2G13.5/
     +25X,'TMR(NZNBAS),TMR(NRM),QSI= ',3G13.5)
  505 FORMAT(1X,'FLOOR:CHECK-- I,IZW,IZWD(I)= ',3I5)
  506 FORMAT(5X,'FLOOR:CHECK--I,IZW,IZWE,CONDWL(I),T1,TMPN(1,IZW)= '/
     +5X,3I3,3G13.5)
      END