一、源代码： MODULE TYPEDEF IMPLICIT NONE PRIVATE FILEID,FILENAME,LIST SAVE SIZE TYPE STUDENT INTEGER :: NUM INTEGER :: CHINESE,ENGLISH,MATH,SCIENCE,SOCIAL END TYPE TYPE DATALINK TYPE(STUDENT) :: ST TYPE(DATALINK),POINTER :: PRE TYPE(DATALINK),POINTER :: NEXT ENDTYPE INTEGER :: SIZE INTEGER :: FILEID=10 CHARACTER(LEN=10) :: FILENAME='DATA1.TXT' TYPE(DATALINK),POINTER :: LIST INTERFACE OUTPUT MODULE PROCEDURE OUTPUT1 MODULE PROCEDURE OUTPUT2 MODULE PROCEDURE OUTPUT3 ENDINTERFACE CONTAINS SUBROUTINE OPENFILE() IMPLICIT NONE LOGICAL :: ALIVE INTEGER :: STAT=0 CHARACTER(LEN=100) :: HEADLINE TYPE(DATALINK),POINTER :: P INQUIRE(FILE=FILENAME,EXIST=ALIVE) IF(.NOT.ALIVE) THEN WRITE(*,"(/,A9,A,/)") FILENAME," IS NOT EXIST,PLEASE CHECK IT!" STOP ENDIF OPEN(FILEID,FILE=FILENAME,STATUS='OLD') ALLOCATE(LIST) !一边读取数据，一边形成双向环状串行 P=>LIST !point to the head of datalink SIZE=0 READ(FILEID,FMT=*) HEADLINE DO WHILE(.TRUE.) READ(FILEID,FMT=*,IOSTAT=STAT) P%ST !%NUM,P%ST%CHINESE,P%ST%ENGLISH,P%ST%MATH,P%ST%SCIENCE,P%ST%SOCIAL IF(STAT/=0) THEN !if failed to read,back to the last one,and deallocate the current memory. P=>P%PRE DEALLOCATE(P%NEXT) P%NEXT=>LIST !make the last pointer of datalink pointing to the fist one to form circle datalink EXIT ELSE SIZE=SIZE+1 ALLOCATE(P%NEXT) P%NEXT%PRE=>P !上一个为当前，将下一个pre指向当前 P=>P%NEXT !下一个为当前 P%PRE%NEXT=>P !下一个pre的next指向当前 NULLIFY(P%NEXT) ENDIF ENDDO LIST%PRE=>P !退出循环时，p为串行的最后一个，将list的pre指向最后一个构成环 ENDSUBROUTINE !功能：选择正序或逆序全部打印输出 SUBROUTINE OUTPUT1(ORDER) IMPLICIT NONE LOGICAL :: ORDER INTEGER :: COUNT TYPE(DATALINK),POINTER :: P SELECT CASE(ORDER) CASE(.TRUE.) P=>LIST COUNT=0 WRITE(*,"(6A8)") "座位号","中文","英文","数学","科学","社会" P=>LIST DO WHILE(.TRUE.) IF(.NOT.ASSOCIATED(P)) THEN WRITE(*,"(/,A,I,/)") "DONE! TOTAL RECORDS:",COUNT EXIT ENDIF WRITE(*,"(6(3X,I3,2X))") P%ST !%NUM,P%ST%CHINESE,P%ST%ENGLISH,P%ST%MATH,P%ST%SCIENCE,P%ST%SOCIAL P=>P%NEXT COUNT=COUNT+1 IF(COUNT-SIZE.EQ.0) EXIT ENDDO CASE (.FALSE.) P=>LIST COUNT=SIZE WRITE(*,"(6A8)") "座位号","中文","英文","数学","科学","社会" P=>LIST%PRE DO WHILE(.TRUE.) IF(.NOT.ASSOCIATED(P)) THEN WRITE(*,"(/,A,I,/)") "DONE! TOTAL RECORDS:",COUNT EXIT ENDIF WRITE(*,"(6(3X,I3,2X))") P%ST !%NUM,P%ST%CHINESE,P%ST%ENGLISH,P%ST%MATH,P%ST%SCIENCE,P%ST%SOCIAL P=>P%PRE COUNT=COUNT-1 IF(COUNT.EQ.0) EXIT ENDDO CASE DEFAULT WRITE(*,"(/,A,/)") "WRONG CHOICE! NO THIS CHOICE(1=ORDERED,2=REVERSED)." ENDSELECT ENDSUBROUTINE !功能：打印输出一条记录 SUBROUTINE OUTPUT2(NOSEAT) IMPLICIT NONE INTEGER :: NOSEAT INTEGER :: COUNT TYPE(DATALINK),POINTER :: P P=>LIST COUNT=0 IF((NOSEAT.GT.0).AND.(NOSEAT.LE.SIZE)) THEN WRITE(*,"('NO.SEAT NEED TO BE PRINT IS:',I3)") NOSEAT WRITE(*,"(6A8)") "座位号","中文","英文","数学","科学","社会" DO WHILE(.TRUE.) COUNT=COUNT+1 IF(NOSEAT-COUNT.EQ.0) EXIT P=>P%NEXT ENDDO WRITE(*,"(6(3X,I3,2X))") P%ST !%NUM,P%ST%CHINESE,P%ST%ENGLISH,P%ST%MATH,P%ST%SCIENCE,P%ST%SOCIAL ELSE WRITE(*,"(/,'WRONG NO.SEAT! NOSEAT SHOULD BE IN THE RANGE OF: (',I1,',',I3,']',/)") 0,SIZE STOP ENDIF ENDSUBROUTINE !功能：打印部分记录，可选择正循环打印，也可选择逆循环打印 SUBROUTINE OUTPUT3(S,E,ORDER) IMPLICIT NONE INTEGER :: S,E LOGICAL :: ORDER INTEGER :: LEN,COUNT TYPE(DATALINK),POINTER :: P,ST LEN=E-S+1 ST=>LIST COUNT=0 DO WHILE(.TRUE.) COUNT=COUNT+1 IF(S-COUNT.EQ.0) EXIT ST=>ST%NEXT ENDDO WRITE(*,"(6A8)") "座位号","中文","英文","数学","科学","社会" SELECT CASE(ORDER) CASE(.TRUE.) IF(LEN.LT.0) LEN=LEN+SIZE !ELSEIF(LEN.EQ.0) THEN ! LEN=1 !ENDIF P=>ST COUNT=0 DO WHILE(.TRUE.) WRITE(*,"(6(3X,I3,2X))") P%ST !%NUM,P%ST%CHINESE,P%ST%ENGLISH,P%ST%MATH,P%ST%SCIENCE,P%ST%SOCIAL COUNT=COUNT+1 IF(COUNT-LEN.EQ.0) EXIT P=>P%NEXT ENDDO CASE(.FALSE.) IF(LEN.GT.0) LEN=LEN-SIZE P=>ST COUNT=0 DO WHILE(.TRUE.) IF(LEN.GT.0) THEN WRITE(*,"(6(3X,I3,2X))") P%ST !%NUM,P%ST%CHINESE,P%ST%ENGLISH,P%ST%MATH,P%ST%SCIENCE,P%ST%SOCIAL COUNT=COUNT+1 IF(COUNT-LEN.EQ.0) EXIT P=>P%PRE ELSE WRITE(*,"(6(3X,I3,2X))") P%ST !%NUM,P%ST%CHINESE,P%ST%ENGLISH,P%ST%MATH,P%ST%SCIENCE,P%ST%SOCIAL IF(COUNT-LEN+1.EQ.0) EXIT P=>P%PRE COUNT=COUNT-1 ENDIF ENDDO CASE DEFAULT ENDSELECT ENDSUBROUTINE ENDMODULE PROGRAM EX1013 USE TYPEDEF IMPLICIT NONE CHARACTER :: ALL INTEGER :: STARTNO,ENDNO,NOSEAT LOGICAL :: ORDER INTEGER :: STAT=0 CALL OPENFILE() DO WHILE(STAT.EQ.0) WRITE(*,"(/,A)") "WHICH PART OF DATABASE WANTED(A=ALL,P=PART,S=SINGLE):" READ(*,FMT='(A)',IOSTAT=STAT) ALL SELECT CASE(ALL) CASE('A') WRITE(*,*) "YOU CHOOSE TO PRINT ALL RECORDS BY ORDERED OR REVERSED(T=ORDERED,F=REVERSED):" READ(*,FMT=*,IOSTAT=STAT) ORDER CALL OUTPUT(ORDER) CASE('S') WRITE(*,*) "YOU CHOOSE TO PRINT A SINGLE RECORD,WHICH ONE:" READ(*,FMT="(I3)",IOSTAT=STAT) NOSEAT !WRITE(*,*) CALL OUTPUT(NOSEAT) CASE('P') WRITE(*,*) "THE START AND END NO. FOR OUTPUTING(STARTNO,ENDNO):" READ(*,FMT=*,IOSTAT=STAT) STARTNO,ENDNO IF(STARTNO.EQ.1.AND.ENDNO.EQ.SIZE) THEN CALL OUTPUT1(.TRUE.) CYCLE ENDIF STARTNO=MOD(STARTNO,SIZE) ENDNO=MOD(ENDNO,SIZE) IF(STARTNO.LE.0) STARTNO=STARTNO+SIZE IF(ENDNO.LE.0) ENDNO=ENDNO+SIZE IF(ENDNO.EQ.STARTNO) THEN CALL OUTPUT(STARTNO) ELSE!IF(ENDNO.LT.STARTNO) THEN WRITE(*,*) "YOU CHOOSE TO PRINT ALL RECORDS BY ORDERED OR REVERSED(T=ORDERED,F=REVERSED):" READ(*,FMT=*,IOSTAT=STAT) ORDER CALL OUTPUT(STARTNO,ENDNO,ORDER) !ELSE !ORDER=.TRUE. !CALL OUTPUT(STARTNO,ENDNO,ORDER) ENDIF CASE DEFAULT WRITE(*,"(/,A,/)") "NO THIS CHOICE!PLEASE CHOOSE 'A','P' OR 'S'(A=ALL,P=PART,S=SINGLE)." EXIT ENDSELECT ENDDO ENDPROGRAM 二、数据文件（data1.txt）： 座号 中文 英文 数学 自然 社会 1 69 68 51 52 66 2 81 63 99 90 60 3 62 89 52 94 94 4 54 74 92 86 63 5 91 71 73 94 50 6 74 76 90 76 63 7 59 73 77 63 84 8 79 59 68 67 77 9 78 74 94 60 84 10 95 59 76 74 98 11 99 72 94 83 86 12 79 96 99 74 97 13 69 84 83 82 63 14 62 89 82 74 78 15 96 99 52 57 71 16 93 64 57 62 59 17 98 71 84 79 92 18 72 82 72 99 79 19 63 76 77 96 53 20 54 68 73 60 99 21 79 62 93 67 75 22 69 89 74 92 63 23 51 54 61 86 53 24 96 95 51 67 99 25 70 54 95 93 94