      SUBROUTINE GRNDEX(TODDB,WSPED,SOLRH,KM) 
C 
C TAPE60 WRITE.  ECHO OF NAMELIST INPUT 
C TAPE18 READ.   NAMELIST INPUT 
C TAPE41 READ.   SEQUENTIAL COMPRESSED WEATHER DATA  (WORKING FILE) 
C TAPE43 WRITE/READ. GROUND TEMPERATURES(INTERNAL TO THIS ROUTINE)
C 
C  EXECUTIVE CODE FOR DETAILED GROUND HEAT TRANSFER 
C   BY R D FISCHER, BATTELLE, WITH SUGGESTIONS FOR APPROACH FROM
C   TOM BECKEY OF HONEYWELL 
C  ICODE = 1  READ NAMELIST INPGND, INITIALIZE NODAL GEOM 
C             AND HEAT TRANSFER COEFS (ICODE=2 IS 
C             INCLUDED IN ICODE = 1 FOR NOW)
C        =2   RUN PRECONDITIONING MONTHS
C        =3   HOURLY GROUND HEAT TRANSFER CALC. 
C             (USES MEAN HRLY VALUES FOR TODDB,WSPED,SOLRH) 
C        =4   FINISH GROUND CALCULATIONS FOR THE MONTH
C             FOR THE MONTH  INT(DAYMON/(NDAYS-1) TIMES TO
C                 INITIALIZE FOR NEXT MONTH.
C  TODDB  MEAN HRLY OUTDOOR DRYBULB AIR TEMP, F 
C  WSPED  MEAN HRLY WIND SPEED,MPH
C  SOLRH  MEAN HRLY TOTAL SOLAR RADIATION ON HORIZONTAL SURFACE 
C  TIMEYR   TIME OF YEAR AT START OF GROUND PRECONDITIONING 
C           (SET IN WWEATH) 
C  NMNPRE  NO. OF MONTHS OF PRECONDITIONING(READ IN WWEATH) 
C  NDHRS  NO. OF HOURS PER MONTH(INCL PRECONDITIONING DAY-- 
C            SET IN WWEATH) 
C  IGINIT =1 TO USE TSOILI FOR INITIAL GROUND TEMPS 
C         =2 TO USE TG VALUES FROM TAPE43 FOR INITIALIZATION
C        =-2 WRITE INITIAL TG'S AT START OF FIRST PRECOND DAY TO TAPE43 
CMDK NKONST
CMDK NWL
CMDK NWN
CMDK NZN
CMDK NZW
CMDK BLK53
CMDK BLK55
CMDK BLKBSF
CMDK BLKHWG
CMDK BLKQS
CMDK CNSTRK
CMDK ENCBK1
CMDK ENCBK2
CMDK ENCBLK
CMDK IZWQ
CMDK SOILB
CMDK SURFAR
CMDK TEMPB
CMDK TYRGND
CMDK UABAS
      DIMENSION ODDB(24,4),WSPEED(24,4),SOLARH(24,4), 
     +TDBT(24), WSPDT(24), SOLRT(24),TPR(28),IP(28) 
     +,NDYM(12)
      INTEGER*4 LAST1
      NAMELIST/INPGND/ABSRPG,CPSOIL,IGINIT,NPRINT,PHASE,
     +                RFIELD,RHSOIL,TEAMP,TEAV,TSOILI,
     +                UBASF,UBWBG,XKSOIL,ZDEPTH
C INPUTS IN NAMELIST INPGND:
C  ABSRPG - ABSORPTIVITY OF GROUND TO SOLAR RADIATION
C  CPSOIL - SPECIFIC HEAT OF SOIL AROUND BASEMENT, BTU/LBM-F
C  IGINIT - =1 USE TSOILI FOR INITAIL GROUND TEMPERATURES
C           =2 USE GROUND TEMP FROM TAPE43 FOR INITIALIZATION
C              (SET IN A PREV RUN WITH IGINIT = -1 -- THIS OPTION
C              WILL REDUCE EXECUTION TIME FOR HANDBOOK RUNS)
C           = -2 INITIAL SOIL TEMPS WILL BE CALC FROM A KUSUDA
C             RELATIONSHIP AND WRITTEN TO TAPE43
C    NOTE: YOU MUST RUN ONCE WITH -2 AND THEN CHANGE TO 2!!!
C  NPRINT - PRINT GROUND TEMP EVERY NPRINT HOURS
C  PHASE  - PHASE ANGLE OF EARTH TEMP AT SURFACE(SEE KUSUDA REF.),
C           RADIANS
C  RFIELD - RADIUS FROM CENTER OF BASEMENT TO FAR-FIELD NODE, FT      
C  RHSOIL - DENSITY OF SOIL, LBM/FT3
C  TEAMP  - TEMPERATURE AMPLITUDE AT EARTHS SURFACE, F
C  TEAV   - AVERAGE ANNUAL EARTH TEMPERATURE, F
C  TSOILI - INITIAL VALUE FOR SOIL TEMPERATURE, F
C  UBASF AND UBWBG  -  OVERALL HEAT FLOW TERMS AS USED IN
C         THE SINGLE ZONE MODEL AND USED HERE FOR PRECONDITIONING
C         THE GROUND NEAR THE BSMT WALLS AND FLOOR,(USE 0.5 FOR BOTH)     
C         THESE VALUES ARE USED IN BSMTPRE.FOR
C  XKSOIL - THERMAL CONDUCTIVITY OF SOIL, BTU/HR-FT-F
C  ZDEPTH - DEPTH FROM GROUND SURFACE TO CONSTANT TEMP NODE, FT
      DATA IP/1,3,5,6,7,2,4,8,10,12,13,14,
     +        9,11,15,27,17,18,16,28,19,20, 
     +        21,22,23,24,25,26/
      DATA NDAYQ/1/,NDBG/0/ ,IPRBG/1/
      DATA NDYM/31,28,31,30,31,30,31,31,30,31,30,31/ 
      GO TO (100,200,300,400),ICODE 
  100 CONTINUE
C   
      OPEN(18,FILE='TAPE18',STATUS='OLD',IOSTAT=IO18)
      IF(IO18.NE.0)THEN
        WRITE(60,*) ' GROUND: CANT OPEN TAPE18 WITH NAMELIST INPGND'
        STOP ' GROUND: CANT OPEN TAPE18 WITH NAMELIST INPGND'
        END IF
      READ(18,INPGND,END=999)
      CLOSE(18)
      WRITE(60,INPGND)
C     
C  FIND BSMT FLOOR AND WALL DATA FROM ENCLOSURE DATA
      KF=KONSTA(IZWD(1))
      KW=KONSTA(IZWE(1))
      NLMF=NLMP(KF) 
      NLMW=NLMP(KW) 
      THFLR=0.
      THWAL=0.
      DO 102 I=1,NLMF 
  102 THFLR=THFLR+WX(I,KF)
      DO 104 I=1,NLMW 
  104 THWAL=THWAL+WX(I,KW)
      ABASFT=ABASF(1)+ABASF(2)
      HWBG=0. 
      ABWBGT=0. 
      DO 106 I=1,4
      IZW=IZWE(I) 
      ABWBGT=ABWBGT+AWALLA(IZW) 
  106 HWBG=HWBG+HGTA(IZW) 
C  NOTE: HEIGHT OF NODES IN BLW GRND BSMT WALL IS SET BY ENCL INPUT DATA
C        SUGGESTION: WITH BASEMENT, SET CENTER OF NODE 8 TO 3 FT TO 
C                    AGREE WITH MSMT OF SOIL TEMP IN HSE A AND B. 
C                    WITH CRWSPC, SET NODE HEIGHTS = .1,.2,.3,.4 X
C                    CRWSPC HEIGHT. 
      DZN(1)=HGTA(IZWE(1))
      DZN(2)=HGTA(IZWE(2))
      DZN(8)=HGTA(IZWE(3))
      DZN(9)=HGTA(IZWE(4))
      IF(IGINIT.EQ.1)THEN 
          DO 110 I=1,28 
  110     TG(I)=TSOILI
          ENDIF 
C  SET UP NODAL GEOMETRY AND HEAT TRANSFER PARAMETERS 
      CALL SETNOD(TIMEYR,HOGRND)
      CALL SETND1(TIMEYR,HOGRND)
C 
      IF (IGINIT.EQ.2)THEN
C  GET INITIAL GROUND TEMPS FROM TAPE43 
C    TAPE41 TO FIRST PRECONDITIONING DAY AND ADVANCE POINTER ON TAPE41
C    TO 1ST PRECONDITIONING DAY
          OPEN(43,FILE='TAPE43',STATUS='UNKNOWN',IOSTAT=IO43) 
          IF(IO43.NE.0)THEN
            WRITE(60,*)' GRNDEX: CANT OPEN TAPE43 FILE'
            STOP ' GRNDEX: CANT OPEN TAPE43 FILE'
            ENDIF
          READ(43,*,END=420)(TG(I),I=1,28)
          CLOSE(43) 
          NREAD=NDHRS*NMNPRE
          DO 112 I=1,NREAD
C              NMONTQ IS A DUMMY          
          READ(41,503,END=430)NMONTQ 
  112     CONTINUE
          NMONTQ=NMNPRE 
          NDAYT=NDHRS/24
          NDAYTQ=NDAYT-1
          ASSIGN 270 TO LAST1 
          GO TO 260 
          ENDIF 
C 
C  RUN GROUND PRECOND FOR NMPRE MONTHS
C   FINAL NDAYS-1 WEATHER VALUES WILL BE STORED FOR REPEAT CALC 
C     (NOTE:  ARRAYS ARE DIM FOR MAX OF NDAYS-1=4)
  200 NMONTQ=1
      ASSIGN 270 TO LAST1 
      IF(NPRINT.GT.0)THEN 
          DO 201 I=1,28 
          IPQ=IP(I) 
  201     TPR(I)=TG(IPQ)
          WRITE(60,504)(TPR(I),I=1,28) 
          ENDIF 
      NDAYT=NDHRS/24
      NDAYTQ=NDAYT-1
  207 NDAY=0
  208 NDAY=NDAY+1 
      IF(NDAY.GT.NDAYT)GO TO 220
      IF(NDAY.GT.1)NDY=NDAY-1 
C  READ 24 HOURS OF DATA
      DO 209 I=1,24 
C         TPR(1) BELOW IS A DUMMY VAR      
      READ(41,*)TDBT(I),TPR(1),WSPDT(I),SOLRT(I),TPR(1),MONLST 
C  SAVE VALUES   FOR REPEAT CALC
      IF(NDAY.GT.1.AND.NDY.LE.4)THEN 
          ODDB(I,NDY)=TDBT(I) 
          WSPEED(I,NDY)=WSPDT(I)
          SOLARH(I,NDY)=SOLRT(I)
          ENDIF 
  209 CONTINUE
      IHR=0 
  210 IHR=IHR+1 
      IF(IHR.EQ.25)THEN 
          IF(NDBG.EQ.1)WRITE(60,505)NDAYQ
          NDAYQ=NDAYQ+1 
          GO TO 208 
          ENDIF 
      IF(IPRBG.EQ.1)THEN
        CALL CURS(20)
        WRITE(*,542)IHR,NDAY,NDAYQ,MONLST,KM
  542 FORMAT(1X,'GRNDEX 1: INITIAL DAYS; IHR,NDAY,NDAYQ,MONLST,KM= ',
     + 5I4)     
      ENDIF
      TODDB=TDBT(IHR) 
      WSPED=WSPDT(IHR)
      SOLRH=SOLRT(IHR)
C  GET GROUND HEAT TRANSFER COEF
      HOGRND=HGRN(WSPED)
      CALL SETND2(TIMEYR,HOGRND)
      CALL EXPLCT(TODDB,SOLRH,HOGRND,ABSRPG) 
      GO TO 210 
C 
C  NOW REPEAT CALCULATIONS TO APPROX THE EFFECT ON GROUND 
C   OF AN ENTIRE MONTH OF WEATHER 
C  NOTE: ONLY ABOUT 20 DAYS ARE NEEDED, SO TOTAL DAYS/MON < MAX IS OK 
  220 IEND=INT((NDYM(MONLST)-NDAYT)/NDAYTQ)
      IRPEAT=0
  230 IRPEAT=IRPEAT+1 
      IF(IRPEAT.GT.IEND)GO TO 260 
      NDAY=0
  240 NDAY=NDAY+1 
      IF(NDAY.GT.NDAYTQ)GO TO 230 
      IHR=0 
  250 IHR=IHR+1 
      IF(IHR.EQ.25)THEN 
          IF(NDBG.EQ.1)WRITE(60,505)NDAYQ
          NDAYQ=NDAYQ+1 
          GO TO 240 
          ENDIF 
      IF(IPRBG.EQ.1)THEN
        CALL CURS(21)
        IF(ICODE.EQ.4)THEN
          WRITE(*,545)IHR,NDAY,NDAYQ,MONLST,KM
        ELSE
          WRITE(*,543)IHR,NDAY,NDAYQ,MONLST,KM
        ENDIF
  543 FORMAT(1X,'GRNDEX 2: REPEAT INITIAL DAYS; IHR,NDAY,NDAYQ,MONLST,',
     +       'KM= ',5I4)     
  545 FORMAT(1X,'GRNDEX 4: FINISH MONTH; IHR,NDAY,NDAYQ,MONLST,',
     +       'KM= ',5I4)     
      ENDIF
      TODDB=ODDB(IHR,NDAY)
      WSPED=WSPEED(IHR,NDAY)
      SOLRH=SOLARH(IHR,NDAY)
      HOGRND=HGRN(WSPED)
      CALL SETND2(TIMEYR,HOGRND)
      CALL EXPLCT(TODDB,SOLRH,HOGRND,ABSRPG) 
      GO TO 250 
C 
C  NOW DO PRECONDITIONING FOR THE NEXT MONTH
  260 IF(NPRINT.GT.0)THEN 
          DO 262 I=1,28 
          IPQ=IP(I) 
  262     TPR(I)=TG(IPQ)
          WRITE(60,504)(TPR(I),I=1,28)
          ENDIF 
      GO TO LAST1,(270,410) 
  270 NMONTQ=NMONTQ+1 
      IF(NMONTQ.LE.NMNPRE)GO TO 207 
      IF(IGINIT.EQ.-2)THEN
          OPEN(43,FILE='TAPE43',STATUS='UNKNOWN') 
          WRITE(43,502)(TG(I),I=1,28)
          CLOSE(43) 
          ENDIF 
      IHR=0 
      NDY=0 
      GO TO 500 
C 
C  HOURLY GROUND HEAT TRANSFER CALCULATIONS 
  300 HOGRND=HGRN(WSPED)
      CALL SETND2(TIMEYR,HOGRND)
      CALL EXPLCT(TODDB,SOLRH,HOGRND,ABSRPG) 
C 
C  SAVE WEATHER DATA AFTER THE FIRST DAY
  304 IHR=IHR+1 
      IF(IHR.EQ.25)THEN 
          IF(NDBG.EQ.1)WRITE(60,505)NDAYQ
          NDAYQ=NDAYQ+1 
          NDY=NDY+1 
          IHR=0 
          GO TO 304 
        ENDIF 
      IF(IPRBG.EQ.1)THEN
        CALL CURS(22)
        WRITE(*,544)IHR
  544 FORMAT(16X,'GRNDEX 3: HOURLY CALCULATIONS FOR HR= ',I3)
      ENDIF
      IF(NDY.GE.1.AND.NDY.LE.4)THEN
          ODDB(IHR,NDY)=TODDB 
          WSPEED(IHR,NDY)=WSPED 
          SOLARH(IHR,NDY)=SOLRH 
          ENDIF 
      GO TO 500 
C 
C  REPEAT CALC OF LAST FOUR DAYS TO FINISH MONTH
  400 ASSIGN 410 TO LAST1 
C  !!!
C  USE HEAT FLOWS FROM WALLS AT LAST HOUR OF LAST DAY TO FINISH MONTH 
      MONLST=KM 
C         GET AVERAGES FOR THE PREVIOUS 24 HOURS
      IF(NTBASM.EQ.0)STOP ' GRNDEX:NTBASM=0.! '      
      DATA NTMQU/0/
      IF(NTMQU.EQ.0)THEN
        UBASFRF=UBASF
        UBWBGRF=UBWBG
        TBASMRF=TBASM
        NTMQU=1
      ENDIF
      TBASM=TBASM/NTBASM
      UBASF=0.
      DO 402 I=1,2
      IZW=IZWD(I)
      IJ=15
      IF(I.EQ.2)IJ=27
      QCSURF(IZW)=QCSURFS(IZW)/NTBASM
      UBASF=UBASF+(QCSURF(IZW)/(TBASM-TG(IJ)) - DDWKL(I+4))/AWALLA(IZW)
      QCSURFS(IZW)=0.
  402 CONTINUE
      UBASF=0.5*UBASF
      UBWBG=0.
      DO 404 I=1,4
      IZW=IZWE(I)
      IJ=I
      IF(I.EQ.3)IJ=8
      IF(I.EQ.4)IJ=9
      QCSURF(IZW)=QCSURFS(IZW)/NTBASM
      UBWBG=UBWBG+(QCSURF(IZW)/(TBASM-TG(IJ)) - DDWKL(I))/AWALLA(IZW)
      QCSURFS(IZW)=0.
  404 CONTINUE
      UBWBG=UBWBG/4.
      WRITE(60,*)' GRNDEX 4: REPEAT CALC OF LAST 4 DAYS TO FINISH MONTH'
      WRITE(60,*)' GRNDEX: ADJUSTING TBASM,UBASF,UBWBG VALUES..'
      WRITE(60,*)' INPUT VALUES OF UBASF AND UBWBG= ',UBASFRF,UBWBGRF
      WRITE(60,*)'  AT KM= ',KM,' NEW VALUES OF UBASF,UBWBG= ',UBASF,
     +             UBWBG
      WRITE(60,*)' INPUT VALUE OF BSMT AIR TEMP = ',TBASMRF
      WRITE(60,*)'  MEAN VALUE OF BSMT AIR TEMP(LAST 24 HRS)= ',TBASM
      WRITE(60,*)'  NTBASM= ',NTBASM
      NTBASM=0
      CALL CURS(23)
      WRITE(*,*)' GRNDEX 4: REPEAT CALC OF LAST 4 DAYS TO FINISH MONTH'
      GO TO 220 
  410 CONTINUE
      CALL CURS(21)
      WRITE(*,*)' GRNDEX 4: COMPLETED FINISHING MONTH!                '
      NDY=0 
      IHR=0 
      GO TO 500 
C 
  420 STOP 'GRNDEX:EOF READING TGS FROM TAPE43; SET IGINIT=-2 AND RERUN' 
  430 STOP 'GRNDEX:EOF WHILE ADVANCING ON TAPE41' 
C  ZERO HEAT FLOW ARRAYS
  500 CALL ZERV(6,QBASF(1),QBASF(2),QBWBG(1),QBWBG(2),
     +          QBWBG(3),QBWBG(4),0.,0.,0.,0.)
      TBASM=0.
      CALL CURS(20)
      WRITE(*,506)
      CALL CURS(21)
      WRITE(*,506)
      CALL CURS(23)
      WRITE(*,506)
      RETURN
  999 STOP ' GROUND: EOF ON TAPE18 WITH NAMELIST INPGND'
C 
  502 FORMAT((1X,7(1X,E11.5)))
  503 FORMAT(A10) 
  504 FORMAT(1H0,'T S= ',8X,2G13.5/ 
     +1X,39X,3G13.5/
     +1X,13X,2G13.5/
     +1X,13X,2G13.5/
     +1X,39X,3G13.5/
     +1X,13X,2G13.5/1X,2G13.5/1X,19X,G13.5,7X,G13.5/
     +1X,2G13.5/
     +1X,52X,2G13.5/1X,G13.5,13X,G13.5/ 
     +1X,G13.5,19X,G13.5,20X,G13.5/1X,32X,G13.5)
  505 FORMAT(1X,'GRNDEX:END OF DAY= ',I5) 
  506 FORMAT(80(1H ))
      END 
      FUNCTION HGRN(WSPED)
C 
C  CONVECTIVE HEAT TRANSFER COEF AT GROUND DUE TO WIND VELOCITY 
C    USE CARRIER CORRELATION FOR H AT GROUND SURF 
C    (AN ALTERNATE WHICH GIVES SOMEWHAT LOWER VALUES IS THAT FOR
C     A FLAT PLATE,IE: H=0.431*WSPED**.8 FOR L=10 FT. OR
C     H*(1.0./L)**.2 FOR LOWER L) 
C     UNITS: WSPED, MPH      HGRN, BTU/HR-FT2-F 
      IF(WSPED.LT..4)THEN 
          HGRN=1. 
      ELSE
          HGRN=SQRT(WSPED)/.6584
          ENDIF 
      RETURN
      END 
      SUBROUTINE SETNOD(TIMEYR,HOGRND)
C 
C  SET NODE VALUES FOR BASEMENT TO GROUND HEAT TRANSFER 
C 
      DIMENSION         DRN(28),RR(5),DN(28),DNO(28),VOL(28), 
     +DDZ1(28),DDZ2(28),DDR1(28),DDR2(28),
     +DDZ(6),IR(28),IZ(28),IA(28),A(16),DDWL(6),DRWL(6)
     +,XK(28),I19(4),DDZK(7),I17(6)
C 
CMDK BLK52
CMDK BLK53
CMDK BLK55
CMDK BLK57
CMDK BLKHWG
CMDK ENCBK2
CMDK SOILB
CMDK UABAS
      LOGICAL NDEBG 
C 
C  F1F GIVES THE AVG RADIUS THAT HEAT MUST TRAVEL (ref: ANDREWS,
C  A TRNSYS-COMPATIBLE MODEL OF GROUND-COUPLED STORAGE,SEPT 1979,
C  BNL 51061 UC-59c)
      F1F(Z1,Z2)=2./3.*(Z2**3-Z1**3)/(Z2**2-Z1**2)
      F2F(Z3,Z4)=PI4*(Z4*Z4-Z3*Z3)
C SETUP RADIAL CONNECTIONS (IR IS RADIAL CONNECTED NODE FOR NODE I
      DATA IR/3,4,5,5,6,7,0,10,11,12,12,13,14,0,27, 
     +28,18,19,20,0,22,19,24,25,0,0,17,17/
C  SETUP AXIAL CONNECTIONS
      DATA IZ/2,8,4,10,12,13,14,9,17,11,17,18,
     +19,20,16,21,22,22,24,25,23,24,26,26,26,0,28,21/ 
C  SET AREA INDICATOR 
      DATA IA/1,1,2,2,3,4,6,1,1,
     +2,2,3,4,6,14,14,7,3,4,6,5,
     +8,5,9,6,0,15,15/
      DATA I19/1,2,8,9/ 
      DATA I17/1,3,5,6,0,7/ 
      NDEBG=.FALSE. 
      DATA PI/3.141596/ 
      PI2=2.*PI 
      PI4=PI/4. 
      DO 10 I=1,30
      DO 10 J=1,30
   10 AK(I,J)=0.
      REQBAS=SQRT(ABASFT/PI)
      DEQBAS=2.*REQBAS
      ABWBGC=PI*DEQBAS*HWBG 
C   RATH IS AMPLIFICATION OF HEAT FLOW TO BASEMENT AIR AT WALL
C     TO ACCOUNT  FOR SMALLER WALL AREA WITH CYL COORDINATES
      RATH=ABWBGC/ABWBGT
      REQ1=SQRT(REQBAS**2. - ABASF(2)/PI)
      DEQ1=2.*REQ1
      REQ2=REQBAS+THWAL 
      A(14)=PI*REQ1*REQ1
      A(15)=PI*(REQ2*REQ2-REQ1*REQ1)
      A(16)=ABASFT-A(14)
      DZN(5)=DZN(1)+DZN(2)
      DZN(6)=DZN(5) 
      DZN(7)=DZN(5) 
      DZN(12)=DZN(8)+DZN(9) 
      DZN(13)=DZN(12) 
      DZN(14)=DZN(12) 
      DZN(3)=DZN(1) 
      DZN(4)=DZN(2) 
      DZN(10)=DZN(8)
      DZN(11)=DZN(9)
      ZTF=ZDEPTH-HWBG-THFLR 
      DZN(15)=ZTF/22. 
      DZN(16)=3.*ZTF/22.
      DZN(17)=DZN(15)+DZN(16) 
      DZN(18)=DZN(17) 
      DZN(21)=6.*ZTF/22.
      DZN(22)=DZN(21) 
      DZN(19)=DZN(18)+DZN(22) 
      DZN(20)=DZN(19) 
      DZN(23)=12.*ZTF/22. 
      DZN(24)=DZN(23) 
      DZN(25)=DZN(24) 
      DZN(26)=2.*DZN(23)
      DZN(27)=DZN(15) 
      DZN(28)=DZN(16) 
      IF(IGINIT.EQ.1)GO TO 16 
C   SET INITIAL SOIL TEMPS USING KUSUDA RELATIONSHIP
C     SET DEPTH TO CENTER OF NODES(ZN)
C     (USED TO SET INITIAL GROUND TEMPS)
      ZN(1)=0.5*DZN(1)
      ZN(2)=DZN(1)+0.5*DZN(2) 
      ZN(3)=ZN(1) 
      ZN(4)=ZN(2) 
      ZN(8)=DZN(1)+DZN(2)+0.5*DZN(8)
      ZN(9)=DZN(1)+DZN(2)+DZN(8)+0.5*DZN(9) 
      ZN(10)=ZN(8)
      ZN(11)=ZN(9)
      ZN(5)=0.5*DZN(5)
      ZN(12)=DZN(5)+0.5*DZN(12) 
      ZN(6)=ZN(5) 
      ZN(13)=ZN(12) 
      ZN(7)=ZN(5) 
      ZN(14)=ZN(12) 
      ZN(15)=HWBG+THFLR+0.5*DZN(15) 
      ZN(16)=HWBG+THFLR+DZN(15)+0.5*DZN(16) 
      ZN(17)=DZN(5)+DZN(12)+0.5*DZN(17) 
      ZN(18)=ZN(17) 
      ZN(19)=ZN(6)+ZN(13)+0.5*DZN(19) 
      ZN(20)=ZN(19) 
      ZN(21)=DZN(6)+DZN(13)+DZN(17)+0.5*DZN(21) 
      ZN(22)=ZN(21) 
      ZN(23)=DZN(6)+DZN(13)+DZN(19)+0.5*DZN(23) 
      ZN(24)=ZN(23) 
      ZN(25)=ZN(24) 
      ZN(26)=DZN(6)+DZN(13)+DZN(19)+DZN(24)+0.5*DZN(24) 
      ZN(27)=ZN(15) 
      ZN(28)=ZN(16) 
      ALFZ=XKSOIL/(RHSOIL*CPSOIL) 
      IF(IGINIT.NE.2)THEN
        DO 12 I=1,28
        ZNODE=ZN(I) 
        TG(I)=TGKUS(TIMEYR)
   12   CONTINUE
      ENDIF
C   SET RADIAL WIDTHS OF NODES
   16 DRN(1)=RFIELD/28. 
      DRN(2)=DRN(1) 
      DRN(8)=DRN(1) 
      DRN(9)=DRN(1) 
      DRN(3)=3.*RFIELD/28.
      DRN(4)=DRN(3) 
      DRN(10)=DRN(3)
      DRN(11)=DRN(3)
      DRN(5)=6.*RFIELD/28.
      DRN(12)=DRN(5)
      DRN(17)=DRN(1)+DRN(3) 
      DRN(18)=DRN(5)
      DRN(22)=DRN(17)+DRN(18) 
      DRN(6)=18.*RFIELD/28. 
      DRN(13)=DRN(6)
      DRN(19)=DRN(6)
      DRN(24)=DRN(22)+DRN(19) 
      DRN(15)=REQ1
      DRN(16)=DRN(15) 
      DRN(21)=REQ2
      DRN(23)=DRN(21) 
      DRN(25)=0.
      DRN(26)=0.
      DRN(27)=REQ2-REQ1 
      DRN(28)=DRN(27) 
      RR(1)=REQ2
      RR(2)=RR(1)+DRN(1)
      RR(3)=RR(2)+DRN(3)
      RR(4)=RR(3)+DRN(5)
      RR(5)=RR(4)+DRN(6)
C   DN VALUES ARE DIA TO NODE CENTROID
C   DNO VALUES ARE DIA TO OUTER WALL OF NODE
      DNO(1)=2.*RR(2) 
      D=2.*RR(1)
      DN(1)=F1F(D,DNO(1)) 
      DN(2)=DN(1) 
      DN(8)=DN(1) 
      DN(9)=DN(1) 
      DNO(2)=DNO(1) 
      DNO(8)=DNO(1) 
      DNO(9)=DNO(1) 
      DNO(3)=DNO(1)+2.*DRN(3) 
      DNO(4)=DNO(3) 
      DNO(10)=DNO(3)
      DNO(11)=DNO(3)
      DN(3)=F1F(DNO(1),DNO(3))
      DN(4)=DN(3) 
      DN(10)=DN(3)
      DN(11)=DN(3)
      DNO(5)=DNO(3)+2.0*DRN(5)
      DNO(12)=DNO(5)
      DNO(18)=DNO(5)
      DNO(22)=DNO(5)
      DN(5)=F1F(DNO(3),DNO(5))
      DN(12)=DN(5)
      DN(18)=DN(5)
      DNO(17)=DNO(3)
      DN(17)=F1F(D,DNO(17)) 
      DNO(6)=DNO(5)+2.*DRN(6) 
      DNO(13)=DNO(6)
      DNO(19)=DNO(6)
      DNO(24)=DNO(6)
      DN(6)=F1F(DNO(5),DNO(6))
      DN(13)=DN(6)
      DN(19)=DN(6)
      DN(22)=F1F(D,DNO(22)) 
      DN(15)=2./3.*DEQ1 
      DN(16)=DN(15) 
      DN(21)=2./3.*D
      DN(23)=DN(21) 
      DNO(15)=DEQ1
      DNO(16)=DNO(15) 
      DNO(21)=D 
      DNO(23)=DNO(21) 
      DN(24)=F1F(DNO(23),DNO(24)) 
      DN(7)=DNO(6)+DRN(6) 
      DN(14)=DN(7)
      DN(20)=DN(7)
      DN(25)=DN(7)
      DNO(27)=DNO(21) 
      DNO(28)=DNO(27) 
      DN(27)=F1F(DNO(15),DNO(27)) 
      DN(28)=DN(27) 
C  CALC HEAT FLOW AREAS IN DEPTH DIRECTION
      A(1)=F2F(D,DNO(1))
      A(2)=F2F(DNO(1),DNO(3)) 
      A(3)=F2F(DNO(3),DNO(5)) 
      A(4)=F2F(DNO(5),DNO(6)) 
      A(5)=PI4*D*D
      A(6)=6.*A(4)
      A(7)=A(1)+A(2)
      A(8)=A(7)+A(3)
      A(9)=A(8)+A(4)
      A(10)=PI2*REQBAS*RATH*DZN(1)
      A(11)=PI2*REQBAS*RATH*DZN(2)
      A(12)=PI2*REQBAS*RATH*DZN(8)
      A(13)=PI2*REQBAS*RATH*DZN(9)
C  CALC NODE VOLUMES
      DO 20 I=1,28
      IF(I.EQ.26)GO TO 20 
      L=IA(I) 
      AZ=A(L) 
      VOL(I)=AZ*DZN(I)
   20 CONTINUE
      DO 30 I=1,28
      IF(I.EQ.26)GO TO 30 
      K=IZ(I) 
      L=IA(I) 
      AZ=A(L) 
      DDZ1(I)=0.5*DZN(I)/AZ 
      DDZ2(I)=0.5*DZN(K)/AZ 
   30 CONTINUE
C  CALC DDZ'S FOR SURFACE CONNECTIONS 
      DDZ(1)=0.5*DZN(1)/A(1)
      DDZ(2)=0.5*DZN(3)/A(2)
      DDZ(3)=0.5*DZN(5)/A(3)
      DDZ(4)=0.5*DZN(6)/A(4)
      DDZ(5)=0. 
      DDZ(6)=0.5*DZN(7)/A(6)
C   CALC DDR'S FOR RADIAL CONDUCTION
      DO 40 I=1,28
      IF(I.EQ.26)GO TO 40 
      IF(I.EQ.7.OR.I.EQ.14)GO TO 40 
      IF(I.EQ.20.OR.I.EQ.25)GO TO 40
      J=IR(I) 
      DENOM=PI2*DZN(I)
      DDR1(I)=ALOG(DNO(I)/DN(I))/DENOM
      DDR2(I)=ALOG(DN(J)/DNO(I))/DENOM
   40 CONTINUE
C 
C  DDWL IS FROM OUTER SURF OF BASEMENT WALL TO ADJACENT GROUND CENTROID
C 
      DO 50 I=1,4 
      L=I 
      IF(I.EQ.3)L=8 
      IF(I.EQ.4)L=9 
C           DRWL IS THE RADIAL DISTANCE HEAT HAS TO FLOW FROM OUTER
C           SURF OF BASEMENT WALL TO CENTROID OF ADJACENT GRND NODE      
      DRWL(I)=0.5*(DN(L) - D)
   50 DDWL(I)=ALOG(DN(L)/D)/(PI2*DZN(L))
      DDWL(5)=0.5*DZN(15)/A(14)
      DDWL(6)=0.5*DZN(27)/A(15) 
      RETURN
C 
C * * * * 
      ENTRY SETND1(TIMEYR,HOGRND) 
C    CALC AK'S (CONDUCTANCES BETWEEN NODES) 
C  SETUP FOR VARIABLE K, IF NEEDED LATER
      DO 60 I=1,28
   60 XK(I)=XKSOIL
      DDWKL(1)=DDWL(1)/XK(1)
      DDWKL(2)=DDWL(2)/XK(2)
      DDWKL(3)=DDWL(3)/XK(8)
      DDWKL(4)=DDWL(4)/XK(9)
C         CONDWL(1-4) VALUES ARE USED IN OWALL.FOR      
      CONDWL(1)=XK(1)/DRWL(1)
      CONDWL(2)=XK(2)/DRWL(2)
      CONDWL(3)=XK(8)/DRWL(3)
      CONDWL(4)=XK(9)/DRWL(4)
      DDWKL(5)=DDWL(5)/XK(15) 
      DDWKL(6)=DDWL(6)/XK(27) 
C         CONDWL(5,6) VALUES ARE USED IN FLOOR.FOR      
      CONDWL(5)=XK(15)/(0.5*DZN(15))
      CONDWL(6)=XK(27)/(0.5*DZN(27))
      DO 62 I=1,6 
      IF(I.EQ.5)GO TO 62
      IQ=I17(I) 
      DDZK(I)=DDZ(I)/XK(IQ) 
   62 CONTINUE
C  CALC INNER AK'S
      DO 80 I=1,28
      IF(I.EQ.26)GO TO 80 
      J=IR(I) 
      IF(J.EQ.0)GO TO 70
      AK(I,J)=1./(DDR1(I)/XK(I)+DDR2(I)/XK(J))
      AK(J,I)=AK(I,J) 
   70 K=IZ(I) 
      AK(I,K)=1./(DDZ1(I)/XK(I)+DDZ2(I)/XK(K))
      AK(K,I)=AK(I,K) 
   80 CONTINUE
C   CALC BOUNDARY AK'S
C  BOUNDARY AT BSMT FLR OR WALL IS SOIL TEMP OUTSIDE FLR OR WALL
      AK(15,29)=1./DDWKL(5) 
      AK(29,15)=AK(15,29) 
      AK(27,29)=1./DDWKL(6) 
      AK(29,27)=AK(27,29) 
      DO 82 I=1,4 
      IJ=I19(I) 
      AK(IJ,29)=1./DDWKL(I) 
      AK(29,IJ)=AK(IJ,29) 
   82 CONTINUE
C   CALC THERMAL CAPACITANCE VALUES (S'S) 
      RCP=RHSOIL*CPSOIL 
      DO 90 I=1,28
      IF(I.EQ.26)GO TO 90 
      RCPV=RCP*VOL(I) 
      S(I)=1./RCPV
   90 CONTINUE
C 
      IF(NDEBG)THEN 
          WRITE(60,500)(DZN(I),I=1,28) 
           WRITE(60,512)(ZN(I),I=1,28) 
          WRITE(60,501)(DRN(I),I=1,28) 
          WRITE(60,502)(RR(I),I=1,5) 
          WRITE(60,503)(DN(I),DNO(I),I=1,28) 
          WRITE(60,511)(A(I),I=1,15) 
          WRITE(60,504)(VOL(I),I=1,28) 
          WRITE(60,505)(DDZ1(I),DDZ2(I),I=1,28)
          WRITE(60,506)(DDR1(I),DDR2(I),I=1,28)
          WRITE(60,507)(DDZ(I),I=1,6)
          WRITE(60,508)(DDWL(I),I=1,6) 
          WRITE(60,510)(S(I),I    =1,28) 
          ENDIF 
      NDEBG=.FALSE. 
      RETURN
C 
      ENTRY SETND2(TIMEYR,HOGRND) 
      AK(1,30)=1./(DDZK(1)+1./(HOGRND*A(1)))
      AK(30,1)=AK(1,30) 
      AK(3,30)=1./(DDZK(2)+1./(HOGRND*A(2)))
      AK(30,3)=AK(3,30) 
      AK(5,30)=1./(DDZK(3)+1./(HOGRND*A(3)))
      AK(30,5)=AK(5,30) 
      AK(6,30)=1./(DDZK(4)+1./(HOGRND*A(4)))
      AK(30,6)=AK(6,30) 
      AK(7,30)=1./(DDZK(6)+1./(HOGRND*A(6)))
      AK(30,7)=AK(7,30) 
      IF(ICODE.EQ.2)THEN
C         SET PARAMETERS FOR HEAT FLOW FROM BSMT AIR TO FLOOR AND WALLS      
      ENDIF
      RETURN
  500 FORMAT(1X,'DZN S= ',/6(1X,5G13.5/)) 
  501 FORMAT(1X,'DRN S= '/6(1X,5G13.5/))
  502 FORMAT(1X,'RR S= '/5G13.5)
  503 FORMAT(1X,'DN,DNO S= '/5(F7.2,1X,F7.2)/ 
     +5(F7.2,1X,F7.2)/5(F7.2,1X,F7.2))
  504 FORMAT(1X,'VOL S= '/6(1X,5G13.5/))
  505 FORMAT(1X,'DDZ1,DDZ2= '/5(1X,G12.4,G12.4)/
     +5(1X,G12.4,G12.4)/5(1X,G12.4,G12.4))
  506 FORMAT(1X,'DDR1,DDR2= '/5(1X,G12.4,G12.4)/
     +5(1X,G12.4,G12.4)/5(1X,G12.4,G12.4))
  507 FORMAT(1X,'DDZ S= ',6G13.5) 
  508 FORMAT(1X,'DDWL S= ',6G13.5)
  509 FORMAT(11X,'I,J= ',2I5,'AK= ',G13.5)
  510 FORMAT(1X,'S S= ',6(1X,5G13.5/))
  511 FORMAT(1X,'A= ',5G13.5/4X,5G13.5/4X,6G13.5) 
  512 FORMAT(1X,'ZN S= ',/6(1X,5G13.5/))
      END 
      SUBROUTINE EXPLCT(TODDB,SOLARH,HOGRND,ABSRPG)
C 
C  COMPUTE NEW TEMPS FOR GROUND AROUND BASEMENT USING 
C          EXPLICIT,FORWARD,FINITE DIFFERENCE TECHNIQUE 
C  --METHOD ORIGINATED WITH G. WHITACRE AT BATTELLE-- 
C    THERMAL CONNECTIONS BETWEEN NODES ARE REFERENCED TO TOP,RIGHT
C          BOTTOM,AND LEFT IN NODAL SKETCH
      DIMENSION ITOP(28,2),ILFT(28,2),IRGT(28),IBOT(28) 
     +,JTOP(28),JLFT(28),ISL(6)
C      REAL STAB(28)
CMDK NZN
CMDK NZW
CMDK IZWQ
CMDK BLK52
CMDK SOILB
CMDK TEMPB
CMDK UABAS
      DATA ITOP/30, 1, 30,  3, 30, 30, 30,  2,  8,  4,
     +          10,  5,  6,  7, 29, 15,  9, 12, 13, 14, 
     +          16, 17, 21, 22, 20,  0, 29, 27, 16*0,11,3*0,28,18,0,19, 
     +          4*0/
      DATA IRGT/ 3,  4,  5,  5,  6,  7,  0, 10, 11, 12, 
     +          12, 13, 14,  0, 27, 28, 18, 19, 20,  0, 
     +          22, 19, 24, 25,  0,  0, 17, 17/ 
      DATA IBOT/ 2,  8,  4,  10, 12, 13, 14,  9, 17, 11,
     +          17, 18, 19, 20, 16, 21, 22, 22, 24, 25, 
     +          23, 24, 26, 26, 26,  0, 28, 21/ 
      DATA ILFT/29, 29,  1,  2,  3,  5,  6, 29, 29,  8, 
     +           9, 10, 12, 13,  0,  0, 27, 17, 18, 19, 
     +           0, 21,  0, 23, 24,  0, 15, 16, 4*0,4,6*0,11,4*0,28,0,
     +            22,7*0,15,16/ 
      DATA NU,NS1,NS2/1,1,0/
      DATA JTOP/16*1,2,3*1,2,2,1,2,1,0,1,1/ 
      DATA JLFT/4*1,2,6*1,2,2*1,2*0,2,1,2,1,0,1,0,2*1,0,1,1/
      DATA SMAX/1./ 
      DATA ISL/1,2,8,9,15,27/ 
      DATA NV/0/,NSQ/0/ 
C  NOTE: TIME BETWEEN CALLS TO THIS SUBPROGRAM SHOULD BE 1.0 HR (SET BELOW) 
      DATA DTIMEG/1.0/ 
C  SET SOIL TEMPS AT BACK-SIDE OF BSMT FLOOR AND BLW GRND BSMT WALL 
      IF(ICODE.EQ.3)THEN
        DO 2 I=1,6
        IL=ISL(I) 
        ISOIL=I 
        IF(I.EQ.6)ISOIL=11
        IF(I.LE.4)THEN
          IZ=IZWE(I)
        ELSE
          IZ=IZWD(I-4)
        ENDIF
        TSOIL(ISOIL)=TMP(1,IZ)
    2   CONTINUE      
      ELSE
C         SET TSOIL AT BSMT WALLS AND FLOOR AND UPDATE NODE TEMPS
C         DURING PRECONDITIONING AND END-OF-MONTH CALCULATIONS.
        CALL BSMTPRE
      ENDIF
      TG(30)=TODDB+ABSRPG*SOLARH/HOGRND 
C   LOOP STARTS HERE
      SMIN=20.
      IQ=0
   10 IQ=IQ+1 
      IF(IQ.EQ.7)IQ=IQ+1
      IF(IQ.EQ.14)IQ=IQ+1
      IF(IQ.EQ.20)IQ=IQ+1
      IF(IQ.EQ.25)IQ=IQ+2
      IF(IQ.EQ.15)TG(29)=TSOIL(5) 
      IF(IQ.EQ.27)TG(29)=TSOIL(11)
      AKT=0.
      SUM=0.
      SUM1=0. 
      JT=JTOP(IQ) 
      DO 20 L=1,JT
      IT=ITOP(IQ,L) 
      IF(IT.EQ.0)GO TO 20 
      AKT=AK(IQ,IT) 
      IF(NU.EQ.0)WRITE(60,500)IQ,IT,AKT
      SUM=SUM+AKT 
      SUM1=SUM1+AKT*TG(IT)
   20 CONTINUE
C 
      IR=IRGT(IQ) 
      IF(IR.EQ.0)GO TO 30 
      AKR=AK(IQ,IR) 
      IF(NU.EQ.0)WRITE(60,500)IQ,IR,AKR
      SUM=SUM+AKR 
      SUM1=SUM1+AKR*TG(IR)
   30 CONTINUE
C 
      IB=IBOT(IQ) 
      IF(IB.EQ.0)GO TO 32 
      AKB=AK(IQ,IB) 
      IF(NU.EQ.0)WRITE(60,500)IQ,IB,AKB
      SUM=SUM+AKB 
      SUM1=SUM1+AKB*TG(IB)
   32 CONTINUE
C 
      JR=JLFT(IQ) 
      IF(JR.EQ.0)GO TO 50 
      DO 40 L=1,JR
      IL=ILFT(IQ,L) 
      IF(IL.EQ.0)GO TO 40 
      AKL=AK(IQ,IL) 
      IF(NU.EQ.0)WRITE(60,500)IQ,IL,AKL
      SUM=SUM+AKL 
      IF(IQ.EQ.1)TG(29)=TSOIL(1)
      IF(IQ.EQ.2)TG(29)=TSOIL(2)
      IF(IQ.EQ.8)TG(29)=TSOIL(3)
      IF(IQ.EQ.9)TG(29)=TSOIL(4)
      SUM1=SUM1+AKL*TG(IL)
   40 CONTINUE
   50 TCN=DTIMEG*S(IQ) 
      STB=1.-TCN*SUM
      IF(STB.GT.SMIN)GO TO 60 
      SMIN=STB
      ISMIN=IQ
   60 TG(IQ)=TG(IQ)*STB+TCN*SUM1
      IF(IQ.LT.28)GO TO 10
      TSOIL(6)=TG(7)
      TSOIL(7)=TG(14) 
      TSOIL(8)=TG(20) 
      TSOIL(9)=TG(25) 
      TSOIL(10)=TG(26)
      NU=1
C 
C   END OF LOOP 
C 
C  CHECK TO SEE IF ALL GROUND TEMPS ARE STABLE
      IF(SMIN.GT.SMAX)GO TO 70
      IF(SMIN.LT.0.)GO TO 80
      GO TO 90
   70 IF(NS1.EQ.0)THEN
      WRITE(60,501)ISMIN,SMIN,DTIMEG
      NS1=1 
      GO TO 90
      ENDIF 
   80 IF(NS2.EQ.0)THEN
      WRITE(60,502)ISMIN,SMIN,DTIMEG
      NS2=1 
      NSQ=1 
      GO TO 92
      ENDIF 
   90 CONTINUE
      IF(NV.EQ.0.AND.NSQ.EQ.0)WRITE(60,503)ISMIN,SMIN
      NV=1
   92 CONTINUE
      RETURN
  500 FORMAT(1X,'I,J,AK= ',2I5,G13.5) 
  501 FORMAT(1X,'OKAY TO INCR TIMSTP FOR GROUND T CALC'/
     +1X,'ISMIN,SMAX,DTIME= ',I5,2G13.5)
  502 FORMAT(1X,'--OOPS,TIMSTP FOR GROUND T CALC MUST BE DECR'/ 
     +1X,'ISMIN,SMIN,DTIME= ',I5,2G13.5)
  503 FORMAT(1H0,'*** STABLE GROUND-TEMP CALC---IQ,SMIN= ',I5,G13.5)
      END 
      FUNCTION TGKUS(TIME)
C 
C  KUSUDA RELATIONSHIP FOR FAR-FIELD GROUND TEMP
C    ASHRAE TRANS VOL71(1) 1965,P61-75
CMDK BLK55
C 
      DATA NTQ/0/ 
      DATA PI/3.141596/ 
      DATA HRYR/8766./
      IF(NTQ.NE.0)GO TO 10
      NTQ=1 
      PI2H=2.*PI/HRYR 
      C1=SQRT(PI/(ALFZ*HRYR)) 
   10 C2=C1*ZNODE 
      C3=PI2H*TIME-C2-PHASE 
      TGKUS=TEAV-TEAMP/EXP(C2)*COS(C3)
      RETURN
      END 
      SUBROUTINE BSMTPRE
C
C         CALC TEMPS OF BSMT WALLS AND FLOOR DURING PRECONDITIONING
C         AND END OF MONTH CALCULATIONS.
CMDK NWN
CMDK NZN
CMDK NZW
CMDK IZWQ
CMDK BLKBSF
CMDK ENCBLK
CMDK ENCBK2
CMDK BLKQS
CMDK SOILB
CMDK SURFAR
CMDK TEMP1
CMDK TEMPB
CMDK UABAS
      NRM=NZNBAS
      ID=9
C              UPDATE BSMT WALL TEMPS BELOW GROUND      
C              MUST DO THIS 3600/120 TIMES! (GROUND IS ON 1 HR 
C              TIMESTEP, WHILE OWALLS IS ON A 2 MIN TIMESTEP
C         NTGHR IS 3600/120      
      DO 10 IU=1,NTGHR
      DO 2 I = 1,4
C         BSMT WALL NODES BELOW GROUND      
      IZW=IZWE(I)
      IJ=I
      IF(I.GT.2)IJ=I+5
      RB=1./(UBWBG * AWALLA(IZW) + DDWKL(I))
      QCSURF(IZW)=1./RB * (TBASM - TG(IJ))
      TSOIL(I)=TG(IJ) + QCSURF(IZW) * DDWKL(I)
    2 CONTINUE
C      DATA IQUU/0/
C      IQUU=IQUU+1
      DO 4 I=1,4
      IZW=IZWE(I)
      IJ=I
      IF(I.GT.2)IJ=I+5
      KON=KONSTA(IZW)
      CALL OWALLS(NRM,IZW,ID,KON,DM,DM,DM,DM,IDM)
C         UPDATE TMP VALUES (IS DONE IN ENDLP2 WHEN NOT PRECONDITIONING)      
      DO 3 J=1,4
    3 TMP(J,IZW)=TMPN(J,IZW)
    4 CONTINUE
   10 CONTINUE
C   
      ID=8
      DO 20 IU=1,NTGHR
      DO 12 I = 1, 2
C         BASEMENT FLOOR NODES      
      IZW=IZWD(I)
      KON=KONSTA(IZW)
      IF(I.EQ.1)THEN
        IJ=15
        ISOIL = 5
      ELSEIF(I.EQ.2)THEN
        IJ=27
        ISOIL = 11
      ENDIF
      RB=1./(UBASF * AWALLA(IZW)  + DDWKL(I+4))
      QCSURF(IZW) = 1./RB * (TBASM - TG(IJ))
      TSOIL(ISOIL)=TG(IJ) + QCSURF(IZW) * DDWKL(I+4)
   12 CONTINUE
      DO 14 I = 1, 2
      IZW=IZWD(I)
      KON=KONSTA(IZW)
      IF(I.EQ.1)THEN
        ISOIL = 5
      ELSEIF(I.EQ.2)THEN
        ISOIL = 11
      ENDIF
      CALL FLOOR(NRM,IZW,ID,KON,IDM,TSOIL(ISOIL),DM,IDM)
      DO 13 J=1,4
   13 TMP(J,IZW)=TMPN(J,IZW)
   14 CONTINUE
   20 CONTINUE
      RETURN
      END      
