IFAIAJTHEN TAJAIT END IF END DO END SUBROUTINE
Ø Ø Ø Ø Ø IF(A(I)>A(J))THEN T=A(J)=A(I)=T END IF END DO END SUBROUTINE Vector END PROGRAM Sort 由于参数传递为引用传递,因此例程内虚参的改变会反映在实参上,调用后 数组的顺序就变成有序的。 例 7 -5 虚参具有目标属性,实参为指针 Ø PROGRAM Sort Ø IMPLICIT NONE Ø INTEGER, DIMENSION(10), TARGET: : X=(/3, 6, 9, -1, 56, 4, 6, 0, 0, 8/) Ø INTEGER, DIMENSION(: ), POINTER: : P !实参P POINTER Ø P=>X Ø CALL Vector(P) Ø PRINT*, P Ø (略:子程序例程Vector同例 7 -4) !虚参A Target Ø END PROGRAM Sort
Ø 指针P先指向目标X,做为实参传入子程序。指针P作为目标X的引用 或别名,实质传入子程序的仍是X,只不过要在声明变量X中增加 TARGET属性,以便赋值给指针。 例7 -6 实参、虚参皆为指针。 Ø Ø Ø Ø PROGRAM Sort IMPLICIT NONE INTEGER, DIMENSION(10), TARGET: : X=(/3, 6, 9, -1, 56, 4, 6, 0, 0, 8/) INTEGER, DIMENSION(: ), POINTER: : P ! 实参P POINTER P=>X CALL Vector(P) PRINT*, P CONTAINS SUBROUTINE Vector(A) INTEGER, DIMENSION(: ), POINTER: : A ! 虚参A POINTER INTEGER I, J, T DO I=1, SIZE(A)-1 DO J=I+1, SIZE(A) IF(A(I)>A(J))THEN T=A(J)=A(I)
创建链表的实现函数为: Ø Ø Ø Ø Ø FUNCTION link_create(head, len) !head 结点指针,len结点个数 TYPE(NODE), POINTER: : link_create, head, p 1, p 2 INTEGER : : len, i PRINT*, ”创建链表,输入首结点值==>” ALLOCATE(p 1) !申请首结点 READ*, P 1%val !输入结点值 NULLIFY(p 1%next) !首结点指针域置空 IF (. NOT. ASSOCIATED(head))THEN head => p 1 !头指针指向首结点 END IF DO i=1, len-1 PRINT*, ”创建链表,输入下一个结点值==>” ALLOCATE(p 2) !申请下一个结点 READ*, P 2%val !输入结点值 NULLIFY(p 2%next) !新结点指针域置空 p 1%next => p 2 !新结点连接到前一个结点 p 1 => p 1%next !p 1 指向最后一个结点 END DO link_create => head !函数返回头指针 END FUNCTION
Ø Ø Ø Ø Ø Ø END IF IF(i==1)THEN q % next => head => q link_ins => head RETURN END IF p => head j=2 DO WHILE (j < i. AND. ASSOCIATED(p)) p => p%next j = j+1 END DO IF(. NOT. ASSOCIATED(p))THEN PRINT*, ”i out of range!” link_ins => head RETURN ELSE q % next => p % next => q link_ins => head END IF END FUNCTION ! 在表头插入结点 ! 寻找第i -1 个结点 ! 插入的位置在范围之外 ! 在表中插入结点
链表结点删除的实现函数为: Ø Ø Ø Ø Ø Ø Ø FUNCTION link_del(head, i) TYPE(NODE), POINTER : : link_del, head, p, q INTEGER : : i, j IF(i == 1)THEN !删除表头结点 q => head => q % next DEALLOCATE(q) link_del => head RETURN END IF p => head j=2 DO WHILE(j < i. AND. ASSOCIATED(p)) !寻找待删除结点的前趋结点 p => p%next j = j+1 END DO IF(. NOT. ASSOCIATED(p). OR. . NOT. ASSOCIATED(p%next))THEN PRINT*, “i out of range!” RETURN ELSE q =>p%next !删除表中结点 p%next=>q%next DEALLOCATE(q) link_del => head END IF END FUNCTION p
例 7 -7 实参、虚参皆为指针 MODULE Link IMPLICIT NONE Ø Ø Ø TYPE NODE ! 链表的结点定义 INTEGER val TYPE(NODE), POINTER : : next END TYPE Ø Ø CONTAINS ! 链表的创建 FUNCTION link_create(head, len) !head 结点指针,len 结点 Ø Ø Ø Ø Ø 数 TYPE(NODE), POINTER : : link_create, head, p 1, p 2 INTEGER : : len, i PRINT*, ”创建链表,请输入结点值==>” ALLOCATE( p 1) ! 申请新结点 READ*, P 1%val ! 输入结点值 NULLIFY(p 1%next) !新结点指针域置空 IF (. NOT. ASSOCIATED(head))THEN head => p 1 !p 1 接入表头 END IF
Ø Ø Ø Ø Ø Ø DO i =1, len-1 PRINT*, ” 创建链表,请输入下一个结点值==>” ALLOCATE( p 2) ! 申请下一个结点 READ*, P 2%val !输入结点值 NULLIFY(p 2%next) !新结点指针置为空 p 1%next => p 2 !p 2连接到前一个结点 p 1 => p 1% next END DO link_create => head END FUNCTION ! 链表结点的插入 FUNCTION link_ins(head, i, x) TYPE(NODE), POINTER : : link_ins, head, p, q INTEGER : : i, x, j ALLOCATE( q ) ! 为插入结点分配内存 q % val = x IF(. NOT. ASSOCIATED(head)) THEN !空链表 head => q NULLIFY(q % next) link_ins => head RETURN END IF
Ø Ø Ø IF(i==1)THEN q % next => head => q link_ins => head RETURN END IF Ø Ø Ø p => head j =2 DO WHILE(j<i. AND. ASSOCIATED(p)) ! 寻找 i-1 个结点 p => p%next j = j+1 END DO Ø Ø Ø Ø Ø IF(. NOT. ASSOCIATED(p))THEN PRINT*, ”i out of range!” link_ins => head RETURN ELSE q%next => p%next => q link_ins => head END IF END FUNCTION ! 插入在第一个结点位置 !插入的位置在范围之外 !结点插入
Ø Ø Ø Ø Ø Ø !链表结点的删除 FUNCTION link_del(head, i) TYPE(NODE), POINTER: : link_del, head, p, q INTEGER : : i, j IF(i==1)THEN ! 删除头结点 q => head => q%next DEALLOCATE(q) link_del => head RETURN END IF p => head j =2 DO WHILE(j < i. AND. ASSOCIATED(p)) !寻找 i-1个结点 p => p%next j = j+1 END DO IF(. NOT. ASSOCIATED(p). OR. . NOT. ASSOCIATED(p%next))THEN PRINT*, ”i out of range!” RETURN ELSE
Ø Ø Ø Ø Ø Ø Ø q => p%next => q%next DEALLOCATE(q) link_del => head END IF END FUNCTION ! 链表的输出 SUBROUTINE link_print(head) TYPE(NODE), POINTER : : head, p p => head DO WHILE(ASSOCIATED(p)) PRINT*, p%val p => p%next END DO END SUBROUTINE !判断是否到尾 ! 链表的释放 SUBROUTINE link_free(head) TYPE(NODE), POINTER: : head, p DO WHILE(ASSOCIATED(head)) p => head%next DEALLOCATE(p) END DO END SUBROUTINE END MODULE !逐一释放 !指针下移
Ø Ø Ø PROGRAM Main USE Link IMPLICIT NONE INTEGER : : pos, x, len, Ans = 0 TYPE(NODE), POINTER : : head => NULL() !置空头结点,或创建空链表 Ø Ø Ø Ø DO WHILE(Ans/=5) PRINT*, ” 1: 创建链表” PRINT*, ” 2: 插入结点(位置从1开始)” PRINT*, ” 3: 删除链表(位置从1开始)” PRINT*, ” 4: 释放链表” PRINT*, ” 5: 退出” WRITE(*, ”(‘Enter option and press ENTER: ’)”, ADVANCE =“NO”) READ*, Ans SELECT CASE(Ans) CASE(1) IF(ASSOCIATED(head))THEN PRINT*, ”先释放原有链表,再创建新链表” CYCLE END IF PRINT*, ”请输入链表的长度==>”
Ø Ø Ø Ø Ø READ*, len head => link_create(head, len) CALL link_print(head) CASE(2) PRINT*, ”请输入插入结点位置==>” READ*, pos PRINT*, ”请输入插入的结点值==>” READ*, X head => link_ins(head, pos, x) CALL link_print(head) CASE(3) IF(. NOT. (ASSOCIATED(head)))CYCLE PRINT*, ”请输入删除结点位置==>” READ*, pos head => link_del(head, pos) CALL link_print(head) CASE(4) CALL link_free(head) END SELECT END DO Ø Ø CALL link_free(head) END PROGRAM ! 空链表,跳过 ! 结束前,释放链表
- Slides: 32