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 / RESUTL.FOR < prev    next >
Text File  |  1992-04-02  |  3KB  |  113 lines
  1.       SUBROUTINE RESUTL(NRM,K2I,IZW,IZ,IDBG)
  2. C 
  3. C  RESET ENCLOSURE ARRAYS TO REDUCE STORAGE 
  4. C 
  5. C  INPUTS 
  6. C    NRM  ZONE NO.
  7. C    K2I  POSITION IN NENC(NRM,K2I) ARRAY 
  8. C    IZW  OLD IZW 
  9. C    IZ   NEW CONSOLIDATED IZW
  10. C 
  11. C  OUTPUTS
  12. C    IZ   FEASIBLE IZ 
  13. C 
  14. C - - - CONSTANTS 
  15. CMDK NWL
  16. CMDK NWN
  17. CMDK NWZN
  18. CMDK NZN
  19. CMDK NZW
  20. C 
  21. C - - - COMMON BLOCKS 
  22. CMDK ENCBK1
  23. CMDK ENCBLK
  24. CMDK IZPART
  25. CMDK IZZQ
  26. CMDK SURFAR
  27. CMDK WNDBLK
  28. C 
  29.     8 IF(IDBG.NE.0)WRITE(60,502)K2I,IZW,IZ 
  30.       IF(IZW.LT.IZ)THEN 
  31.           IF(IDBG.NE.0)WRITE(60,507)IZW,IZ 
  32.           NENC(NRM,K2I)=IZW 
  33.           IZ=IZ-1 
  34.           GO TO 40
  35.           ENDIF 
  36.       IF(IZW.EQ.IZ)THEN 
  37.           IF(IDBG.NE.0)WRITE(60,503)IZW
  38.           NENC(NRM,K2I)=IZ
  39.           GO TO 40
  40.           ENDIF 
  41. C  LOOK FOR SIMILAR IZW VALUES IN OTHER ZONES 
  42. C                           WHICH ARE SET BY MIRROR IMAGES
  43.       IF(NRM.LT.NROOMS)THEN 
  44.           NRM1=NRM+1
  45.           DO 20 JT=NRM1,NROOMS
  46.           NRMQ=NRMA(JT) 
  47.           IF(NRMQ.EQ.0)GO TO 20 
  48.           N2Q=NWALLA(NRMQ)
  49.           IF(N2Q.EQ.0)GO TO 20
  50.           IF(IDBG.NE.0)WRITE(60,508)NRMQ 
  51.           DO 10 K2Q=1,N2Q 
  52. C   IN OTHER ZONES, COMPARE WITH ALL IZW S
  53.           IZWQ=NENC(NRMQ,K2Q) 
  54.           IF(IDBG.NE.0)WRITE(60,504)NRMQ,K2Q,IZWQ,IZ 
  55.           IF(IZ.EQ.IZWQ)THEN
  56.               IZ=IZ+1 
  57.               IF(IDBG.NE.0)WRITE(60,506)NRMQ,IZWQ
  58.               GO TO 8 
  59.               ENDIF 
  60.    10     CONTINUE
  61.           IF(IDBG.NE.0)WRITE(60,509)NRMQ 
  62.    20     CONTINUE
  63.           ENDIF 
  64.    22 WRITE(60,500)NRM,IZW,IZ
  65.       NENC(NRM,K2I)=IZ
  66.       IDEXP(IZ)=IDEXP(IZW)
  67.       NZNC(IZ)=NZNC(IZW)
  68.       KONSTA(IZ)=KONSTA(IZW)
  69.       HGTA(IZ)=HGTA(IZW)
  70.       XLENA(IZ)=XLENA(IZW)
  71.       WDLEAK(IZ)=WDLEAK(IZW)
  72.       HGTLEAK(IZ)=HGTLEAK(IZW)
  73.       HNPL(IZ)=HNPL(IZW)
  74.       WALLFI(IZ)=WALLFI(IZW)
  75.       WALLFO(IZ)=WALLFO(IZW)
  76.       NWNDA(IZ)=NWNDA(IZW)
  77.       OHANGA(IZ)=OHANGA(IZW)
  78.       HHANGA(IZ)=HHANGA(IZW)
  79.       AWALLA(IZ)=AWALLA(IZW)
  80.       ID=IDEXP(IZW) 
  81.       IF(ID.LE.4)THEN 
  82.           N4=NWNDA(IZW) 
  83.           IF(N4.EQ.0)GO TO 32 
  84.           DO 30 K4=1,N4 
  85.           NIWND(IZ,K4)=NIWND(IZW,K4)
  86.    30     CONTINUE
  87.           ENDIF 
  88. C  CHANGE ANY IZW FOR MIRROR IMAGES IF ANY ARE = IZW RESET ABOVE
  89.    32 IF(NIZWS.EQ.0)GO TO 40
  90.       DO 34 IQ=1,NIZWS
  91.       IF(IZSET(IQ).EQ.IZW)IZSET(IQ)=IZ
  92.       IF(IZWSS(IQ).EQ.IZW)IZWSS(IQ)=IZ
  93.    34 CONTINUE
  94. C *    *     *    *   *   *  BOTTOM OF MAIN LOOP!!!!
  95.    40 CONTINUE
  96. C  SET NO. OF ENCLOSURE ELEMENTS AT END OF THIS ZONE
  97.       IZT=IZ
  98.       RETURN
  99.   500 FORMAT(20X,'FOR ZONE ',I4,' ENCLOSURE NO.(IZW) ',I3,
  100.      +'  CHANGED TO ',I4) 
  101.   502 FORMAT(10X,'BEGIN SEARCH FOR FEASIBLE IZ; K2I,IZW,IZ= ',3I5)
  102.   503 FORMAT(12X,'IZW=IZ, SO NO NEED TO RESET;IZW= ',I3)
  103.   504 FORMAT(15X,'NRMQ,K2Q,IZWQ,IZ= ',4I5)
  104.   506 FORMAT(15X,'FOUND IZW IN ZONE ',I3,' THAT = IZ, SO ', 
  105.      +'INCREMENT IZ;IZW FOUND= ',I3)
  106.   507 FORMAT(15X,'FOUND IZW TO BE LT IZ, SO DONT RESET IT;IZW,IZ= ',
  107.      +2I5)
  108.   508 FORMAT(15X,'LOOKING FOR EXISTING IZW=IZ IN ZONE ',I4) 
  109.   509 FORMAT(15X,'   **DIDNT FIND AN EXISTING IZW=IZ IN ZONE ',I4)
  110.   510 FORMAT(20X,'LOOKING FOR K2 AT ORIG IZW=NEW IZ') 
  111.   511 FORMAT(20X,'  K2J,IZWQ,IZ= ',3I4) 
  112.       END 
  113.