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 / KONSET.FOR < prev    next >
Text File  |  1991-08-16  |  2KB  |  64 lines
  1.       SUBROUTINE KONSET(KONI,KONO)
  2. C 
  3. C  CHECK FOR MIRROR IMAGE CONSTRUCT; IF NONE, SETUP ONE 
  4. C  * * *  CALLED BY STRCTL
  5.       DIMENSION IFLG(6),XK(3),XX(3),XRHO(3),XCP(3)
  6. CMDK NKONST
  7. CMDK CNSTRK      
  8.       DATA IDBG/0/
  9. C 
  10.       CALL ZERVI(6,IFLG)
  11.       NLI=NLMP(KONI)
  12. C 
  13. C  SET MIRRORED DATA IN TEMPORARY ARRAYS
  14.       IF(NLI.EQ.1)THEN
  15.           XK(1)=WK(1,KONI)
  16.           XX(1)=WX(1,KONI)
  17.           XRHO(1)=WRHO(1,KONI)
  18.           XCP(1)=WCP(1,KONI)
  19.           ENDIF 
  20.       IF(NLI.EQ.3)THEN
  21.           I=NLI+1 
  22.           DO 10 J=1,NLI 
  23.           I=I-1 
  24.           XK(I)=WK(J,KONI)
  25.           XX(I)=WX(J,KONI)
  26.           XRHO(I)=WRHO(J,KONI)
  27.           XCP(I)=WCP(J,KONI)
  28.    10     CONTINUE
  29.           ENDIF 
  30. C  NOW CHECK TO SEE IF ANY CONSTRUCT IS THE SAME AS MIRRORED DATA 
  31.       DO 100 IK=1,NCONS 
  32.       NL=NLMP(IK) 
  33.       IF(NL.NE.NLI)GO TO 100
  34.       DO 20 IL=1,NL 
  35.       IF(XK(IL).NE.WK(IL,IK))GO TO 100
  36.       IF(XX(IL).NE.WX(IL,IK))GO TO 100
  37.       IF(XRHO(IL).NE.WRHO(IL,IK))GO TO 100
  38.       IF(XCP(IL).NE.WCP(IL,IK))GO TO 100
  39.    20 CONTINUE
  40. C  ALL VALUES ARE EQUIVALENT, SO FOUND DESIRED CONSTRUCT!!! 
  41.       KONO=IK 
  42.       GO TO 130 
  43.   100 CONTINUE
  44. C - - -COULDNT FIND DESIRED CONSTRUCT, SO SET UP A NEW ONE
  45.       NCONS=NCONS+1 
  46.       IF(NCONS.GT.NKONST)STOP' KONSET: MUST INCREASE NKONST'
  47.       KONO=NCONS
  48.       IF(IDBG.NE.0)WRITE(60,500)KONO,NL
  49.       DO 110 I=1,4
  50.   110 IFXL(I,KONO)=0
  51.       NLMP(KONO)=NL 
  52.       DO 120 I=1,NL 
  53.       WK(I,KONO)=XK(I)
  54.       WX(I,KONO)=XX(I)
  55.       WRHO(I,KONO)=XRHO(I)
  56.       WCP(I,KONO)=XCP(I)
  57.       IF(IDBG.NE.0)WRITE(60,501)I,XK(I),XX(I),XRHO(I),XCP(I) 
  58.   120 CONTINUE
  59.   130 CONTINUE
  60.       RETURN
  61.   500 FORMAT(1H0,'NEW MIRROR-IMAGE CONSTRUCT SETUP; KON,NL= ',2I5)
  62.   501 FORMAT(1X,'LAYER NO.= ',I3,' K,X,RHO,CP= ',4G13.5)
  63.       END 
  64.