計程12/26上課內容

[gazelle ( )]

課本 p541~p543
     p549~p553
上課時用到的程式

        PROGRAM EX1
        CHARACTER*20 A
        INTEGER NUM
        A='ABCDEFGH'
        PRINT*,A(1:1)

        STOP
        END

* INDEX(A,B)
*傳回子字串B在母字串A中第一次出現的位置
* If B does not occur in A,the value 0 is returned.

C       NUM=INDEX(A,'E')
C       NUM=INDEX(A,'EF')
C       NUM=INDEX(A,'EG')
C       A(4:)
C       PRINT*,A(2:5)


        PROGRAM CRYPTOGRAM

        CHARACTER*26 ALFBET
        PARAMETER (ALFBET='ABCDEFGHIJKLMNOPQRSTUVWXYZ')
        INTEGER POSCHR,NEXT
        CHARACTER*26 CODE
        CHARACTER*80 MESSAG,CRYPTO

        PRINT*,'ENTER THE CODE SYMBOL FOR EACH LETTER UNDER THAT LETTER'
        PRINT*,ALFBET
C       READ '(A)',CODE
        CODE='ZYXWVUTSRQPONMLKJIHGFEDCBA'
        PRINT*,CODE
        PRINT*,'ENTER A MESSAGE AND I WILL DISPLAY ITS CRYPTOGRAM:'
        READ '(A)',MESSAG

       DO 10 NEXT=1,LEN(MESSAG)
          POSCHR=INDEX(ALFBET,MESSAG(NEXT:NEXT))
          IF(POSCHR.NE.0)THEN
           CRYPTO(NEXT:NEXT)=CODE(POSCHR:POSCHR)
          ELSE
           CRYPTO(NEXT:NEXT)=MESSAG(NEXT:NEXT)
          ENDIF
10     CONTINUE
       PRINT*,CRYPTO
       STOP
       END


        PROGRAM EX2
        PRINT*,'ABC'//'DE'
        STOP
        END

*S1//S2
*把兩個字串合併成一個較長的字串

C       CHARACTER*10 S1,S2
C       CHARACTER*20 S
C       S1='ABC'
C       S2='DE'
C       S=S1//S2
C       PRINT*,S


      PROGRAM FIG10_9
      CHARACTER*200 TEXT
      CHARACTER*20 OLD,NEW
      INTEGER MAXLEN,CURLEN,OLDLEN,NEWLEN,LENWORD
      LOGICAL CONT
      CHARACTER*1 TEMP

      TEXT='THE BOOK BY KOFFMAN AND FRIEDMEN IN
     +FRACTURED PROGRAMING IS GRREAT?'
      PRINT*,TEXT

      CONT=.TRUE.
      DO WHILE(CONT)
         PRINT*,'INPUT OLD'
         READ *,OLD
         OLDLEN=LENWORD(OLD)
         PRINT*,'INPUT NEW'
         READ *,NEW
         NEWLEN=LENWORD(NEW)
         CALL REPLACE(TEXT,200,100,OLD,OLDLEN,NEW,NEWLEN)
         PRINT*,TEXT
         PRINT*,'CONTINUE?? (Y OR N)'
         READ *,TEMP
         IF(TEMP.EQ.'N')THEN
            CONT=.FALSE.
         ENDIF
      ENDDO

      PRINT*,TEXT
      STOP
      END

        SUBROUTINE REPLACE(TEXT,MAXLEN,CURLEN,OLD,OLDLEN,NEW,NEWLEN)
        CHARACTER*(*) TEXT,OLD,NEW
        INTEGER MAXLEN,CURLEN,OLDLEN,NEWLEN
        INTEGER POSOLD,REVLEN
        CHARACTER*1000 COPY

        POSOLD=INDEX(TEXT,OLD(:OLDLEN))
        IF(POSOLD.NE.0)THEN
          REVLEN=CURLEN+NEWLEN-OLDLEN
           IF(REVLEN.GT.MAXLEN)THEN
             PRINT*,'REVISED TEXT TOO LONG,REPLACEMENT IGNORED'
           ELSE
            IF(POSOLD.EQ.1)THEN
               COPY =NEW(:NEWLEN)//TEXT(POSOLD+OLDLEN:)
            ELSEIF(POSOLD+OLDLEN.EQ.CURLEN)THEN
               COPY =TEXT(:POSOLD-1)//NEW(:NEWLEN)
            ELSE
               COPY =TEXT(:POSOLD-1)//NEW(:NEWLEN)//TEXT(POSOLD+OLDLEN:)
            ENDIF
                TEXT=COPY
                CURLEN=REVLEN
           ENDIF
        ELSE
          PRINT*,OLD,'NOT FOUND,REPLACEMENT IGNORED'
      ENDIF

        RETURN
        END


        INTEGER FUNCTION LENWORD(WORD)
        CHARACTER*(*) WORD
        INTEGER I

        I=1
        DO WHILE (WORD(I:I).NE.' ')
           I=I+1
        ENDDO
        LENWORD=I-1

        RETURN
        END

--
※ 發信站: 批踢踢實業坊(ptt.twbbs.org) 
◆ From: 140.112.22.37