home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / h / house_ii.zip / FOR / CNSLD.FOR < prev    next >
Text File  |  1992-04-15  |  6KB  |  220 lines
  1.        SUBROUTINE CNSLD(NRM,ID,N,NELI,NEL)
  2. C
  3. C  CONSOLIDATE ENCLOSURE ELEMENTS (CALLED BY CONSLD)
  4. C  NRM  ZONE NO.
  5. C  ID   IDEXP VALUE
  6. C  N    NO. OF ENCLOSURE ELEMENTS TO CONSOLIDATE INTO FIRST ELEMENT
  7. C  NELI NL INDICE OF NEL ARRAY FOR EACH N ELEMENTS
  8. C  NEL  ENCLOSURE SEQUENCE NOL. (K2 VALUE -- SEE CONSLD(FIRST PAGE))
  9. C
  10. C - - - CONSTANTS
  11. CMDK NKONST
  12. CMDK NWL
  13. CMDK NWN
  14. CMDK NWZN
  15. CMDK NZW
  16. CMDK NZN
  17.       PARAMETER (NLMX=10)
  18. C      NOTE::  IF NLMX NEEDS CHANGING, CHANGE IT IN CONSLD ALSO!      
  19. C - - - -COMMON BLOCKS
  20. CMDK CNSTRK
  21. CMDK ENCBK1
  22. CMDK ENCBLK
  23. CMDK SURFAR
  24. CMDK WNDBLK
  25. C
  26.       DIMENSION KONI(NLMX),NLMPI(NLMX),AR(NLMX),ARAT(NLMX),NELI(NLMX),
  27.      +          NEL(10,NLMX),KONQ(NLMX),NENQ(NLMX),IZWPR(NLMX)
  28.       IF(N.GT.NLMX)STOP 'CNSLF: N GT NLMX'
  29.       IDBG=0
  30. C
  31. C  GET AREA RATIOS FOR WEIGHTING
  32.       AREAT=0.
  33.       DO 10 I=1,N
  34.       NL=NELI(I)
  35.       K2=NEL(ID,NL)
  36.       IZW=NENC(NRM,K2)
  37.       IZWPR(I)=IZW
  38.       AR(I)=AWALLA(IZW)
  39.       AREAT=AREAT+AR(I)
  40.    10 CONTINUE
  41.       WRITE(60,*)' BELOW IS A LIST OF IZW ELEMENTS THAT ARE BEING',
  42.      +          ' CONSOLIDATED INTO 1ST ELEMENT'
  43.       WRITE(60,*) (IZWPR(I),I=1,N)
  44.       WRITE(60,*)' '
  45. C
  46.       DO 20 I=1,N
  47.       ARAT(I)=AR(I)/AREAT
  48.    20 CONTINUE
  49.       IF(IDBG.NE.0)WRITE(60,510)(ARAT(I),I=1,N)
  50. C
  51. C  CHECK TO SEE IF ALL ELEMENTS HAVE SAME CONSTRUCT NO.  IF SO,
  52. C  A NEW COMPOSITE CONSTRUCT NO. DOES NOT HAVE TO BE GENERATED.
  53.       DO 30 I=1,N
  54.       NL=NELI(I)
  55.       K2=NEL(ID,NL)
  56.       IZW=NENC(NRM,K2)
  57.       KON=KONSTA(IZW)
  58.       KONI(I)=KON
  59.       NLMPI(I)=NLMP(KON)
  60.    30 CONTINUE
  61.       NLM=NLMPI(1)
  62.       KON=KONI(1)
  63.       KONSV=KON
  64.       IFG=0
  65. C
  66.       DO 40 I=2,N
  67.       IF(KON.NE.KONI(I))IFG=1
  68.    40 CONTINUE
  69.       IF(IFG.EQ.0)GO TO 52
  70. C  A NEW CONSTRUCT MUST BE GENERATED
  71. C
  72. C  PROPERTIES FOR NEW CONSTRUCT WILL BE WEIGHTED BY AREA
  73. C
  74. C  NOW CREATE A NEW CONSTRUCT
  75.       NCONS=NCONS+1
  76.       KONSV=NCONS
  77.       IF(NCONS.GT.NKONST)STOP 'CNSLD:MUST INCR NO. OF CONSTRCTS,NKONST'
  78.       IF(IDBG.NE.0)WRITE(60,508)NCONS
  79.       IF(IDBG.NE.0)WRITE(60,507)NLM
  80.       NLMP(NCONS)=NLM
  81. C  SET IFXL ARRAY
  82.       DO 42 I=1,4
  83.       IFXL(I,KONSV)=IFXL(I,KON)
  84.    42 CONTINUE
  85. C
  86.       DO 50 J=1,NLM
  87.       WK(J,NCONS)=0.
  88.       WX(J,NCONS)=0.
  89.       WRHO(J,NCONS)=0.
  90.       WCP(J,NCONS)=0.
  91. C
  92.       DO 50 I=1,N
  93.       NL=NELI(I)
  94.       K2=NEL(ID,NL)
  95.       IZW=NENC(NRM,K2)
  96.       KON=KONSTA(IZW)
  97.       WKI=WK(J,KON)
  98.       WXI=WX(J,KON)
  99.       WRHOI=WRHO(J,KON)
  100.       WCPI=WCP(J,KON)
  101.       KONQ(I)=KON
  102.       WK(J,NCONS)=WK(J,NCONS)+ARAT(I)*WKI
  103.       WX(J,NCONS)=WX(J,NCONS)+ARAT(I)*WXI
  104.       WRHO(J,NCONS)=WRHO(J,NCONS)+ARAT(I)*WRHOI
  105.       WCP(J,NCONS)=WCP(J,NCONS)+ARAT(I)*WCPI
  106.       IF(IDBG.NE.0)WRITE(60,509)J,NRM,IZW,WKI,WXI,WRHOI,WCPI
  107.    50 CONTINUE
  108.       IF(IDBG.NE.0)WRITE(60,501)NRM,ID,(KONQ(I),I=1,N)
  109.       IF(IDBG.NE.0)WRITE(60,502)NCONS
  110. C
  111. C  WEIGHT OR SUM OTHER VALUES FOR THIS CONSOLIDATED ENCLOSURE ELEMENT
  112.    52 NL=NELI(1)
  113.       K2=NEL(ID,NL)
  114.       IZW=NENC(NRM,K2)
  115.       IF(IDBG.NE.0)WRITE(60,511)NRM,IZW,KONSV
  116.       DO 54 J=1,NLM
  117.       IF(IDBG.NE.0)THEN
  118.       WRITE(60,512)J,WK(J,KONSV),WX(J,KONSV),WRHO(J,KONSV),WCP(J,KONSV)
  119.           ENDIF
  120.    54 CONTINUE
  121.       IZWSV=IZW
  122.       NENCS=IZW
  123.       HGT=HGTA(IZW)
  124.       NZON=NZNC(IZW)-8
  125.       HHANG=HHANGA(IZW)
  126.       SLEN=0.
  127.       SAWALA=0.
  128.       SALEAK=0.
  129.       SWDLEK=0.
  130.       SHNPL=0.
  131.       WALFI=0.
  132.       WALFO=WALLFO(IZW)
  133.       OHG=OHANGA(IZW)
  134. C
  135.       NNU=0
  136.       DO 60 I=1,N
  137.       NL=NELI(I)
  138.       K2=NEL(ID,NL)
  139.       NENQ(I)=NENC(NRM,K2)
  140.       IZW=NENQ(I)
  141. C  HEIGHT OF COMPOSITE ENCLOSURE WILL BE KEPT THE SAME FOR COMPOSITE
  142. C     AS FOR FIRST ENCLOSURE, SO MUST SCALE LENGTHS WITH HEIGHT RATIOS
  143.       SLEN=SLEN+XLENA(IZW)*HGTA(IZW)/HGT
  144.       SAWALA=SAWALA+AWALLA(IZW)
  145.       IF(ID.NE.5.AND.ID.NE.6.AND.NZON.NE.NRM)THEN
  146. C      INCREASE WIDTH BUT NOT HEIGHT OF LEAKAGE AREA
  147.           SALEAK=SALEAK+WDLEAK(IZW)*HGTLEAK(IZW)
  148.           SWDLEK=SWDLEK+WDLEAK(IZW)
  149.           SHNPL=SHNPL+HNPL(IZW)
  150.           NNU=NNU+1
  151.           ENDIF
  152.       WALFI=WALFI+ARAT(I)*WALLFI(IZW)
  153.    60 CONTINUE
  154.       IF(IDBG.NE.0)WRITE(60,503)(NENQ(I),I=1,N)
  155.       IF(IDBG.NE.0)WRITE(60,504)NENCS
  156. C
  157. C  NOW OVERWRITE FIRST ENCLOSURE IN THIS IDEXP SECTION WITH COMPOSITE
  158. C         ENCLOSURE VALUES
  159.       KONSTA(IZWSV)=KONSV
  160.       XLENA(IZWSV)=SLEN
  161.       AWALLA(IZWSV)=SAWALA
  162.       IF(ID.NE.5.AND.ID.NE.6.AND.NZON.NE.NRM)THEN
  163.         WDLEAK(IZWSV)=SWDLEK/NNU
  164.         IF(WDLEAK(IZWSV).EQ.0.)THEN
  165.           HGTLEAK(IZWSV)=0.
  166.         ELSE
  167.           HGTLEAK(IZWSV)=SALEAK/WDLEAK(IZWSV)
  168.         ENDIF
  169.         HNPL(IZWSV)=SHNPL/NNU
  170.       ENDIF
  171.       WALLFI(IZWSV)=WALFI
  172.       WALLFO(IZWSV)=WALFO
  173.       HHANGA(IZWSV)=HHANG
  174.       IF(ID.LE.4)THEN
  175.           OHANGA(IZWSV)=OHG
  176. C
  177. C  RESET INDICE OF ALL WINDOWS IN COMPOSITE WALL TO INDICE
  178. C    OF WINDOWS IN FIRST ENCLOSURE ELEMENT
  179. C
  180. C     FIND NO. OF WINDOWS IN FIRST ENCLOSURE ELEMENT
  181.           NWI=NWNDA(IZWSV)
  182. C     NOW ADD VALUES FOR WINDOWS IN OTHER ENCLOSURE ELEMENTS
  183. C     TO ARRAYS FOR WINDOWS IN FIRST ELEMENT
  184.           DO 70 I=2,N
  185.           NL=NELI(I)
  186.           K2=NEL(ID,NL)
  187.           IZW=NENC(NRM,K2)
  188.           NW=NWNDA(IZW)
  189.           IF(NW.GT.0)THEN
  190.               NWNDA(IZWSV)=NWNDA(IZWSV)+NW
  191.               DO 62 K4=1,NW
  192.               NWI=NWI+1
  193.               IF(NWI.GT.NWZN)STOP 'CNSLD: NWZN MUST BE INCR'
  194. C      NOTE: NIWND WINDOW ARRAY MUST BE ENLARGED TO HANDLE THESE
  195. C            ADDITIONAL VALUES IN FIRST ENCLOSURE ELEMENT
  196.               NI=NIWND(IZW,K4)
  197.               NIWND(IZWSV,NWI)=NI
  198.    62         CONTINUE
  199.               ENDIF
  200.    70     CONTINUE
  201.           ENDIF
  202. C
  203.    80 CONTINUE
  204.       RETURN
  205.   501 FORMAT('0 IN ZONE= ',I3,' WITH ENCLOSURE ORIENTATION(ID)= ',I3,
  206.      +', CONSTRUCTS= ',10I3)
  207.   502 FORMAT('  WERE CONSOLIDATED INTO CONSTRUCT= ',I5/)
  208.   503 FORMAT('0 ENCLOSURE ELEMENTS ',10I3)
  209.   504 FORMAT('  WERE CONSOLIDATED INTO ENCLOSURE ELEMENT= ',I3)
  210.   507 FORMAT(1X,'NLMPS FOR NEW CONSTRUCT= ',I5)
  211.   508 FORMAT(1H0,' - - - - - NEW CONSTRUCT BEING PREPARED!!!  NO.=',
  212.      +I5)
  213.   509 FORMAT(1X,'CNSLD:FOR LUMP= ',I3,'   ZONE= ',I3,'  ENCL NO.= ',
  214.      +I5/8X,'K,DX,RHO,CP= ',4G13.5)
  215.   510 FORMAT(1H0,'CNSLD:AREA RATIOS= ',10F10.4)
  216.   511 FORMAT(1X,'CNSLD:CONSOLIDATED CONSTRUCT VALUES FOR ZONE ',I3,
  217.      +' ENCL.NO.= ',I3,' CONSTRUCT NO.= ',I3)
  218.   512 FORMAT(1X,'LUMP NO.=',I4,'  K,DX,RHO,CP= ',4G13.5)
  219.       END
  220.