!Module文件

MODULE FUNC
    IMPLICIT NONE    

   TYPE PERSON
        CHARACTER(LEN=10) :: NAME
        REAL :: HEIGHT,WEIGHT

    ENDTYPE  
    TYPE PPERSON
        TYPE(PERSON),POINTER :: P
    ENDTYPE
    
    CONTAINS
    
    SUBROUTINE SORT(P)
    IMPLICIT NONE
    TYPE(PPERSON):: P(:),TEMP
    INTEGER :: I,J,S
    S=SIZE(P)
    DO I=1,S-1
        DO J=I+1,S
            IF(P(I)%P%HEIGHT<P(J)%P%HEIGHT) THEN
                TEMP=P(I)
                P(I)=P(J)
                P(J)=TEMP
            ENDIF
        ENDDO
    ENDDO
    RETURN
    ENDSUBROUTINE
ENDMODULE



!主程序文件

PROGRAM MAIN
    USE FUNC
    IMPLICIT NONE 
       
    TYPE(PERSON),TARGET :: A(5)=(/PERSON("ZS",175.0,80.0),PERSON("LS",170.0,71.0),&
          PERSON("WE",180.0,83.0),PERSON("ZW",195.0,112.0),PERSON("ZS",173.0,65.0)/)
    TYPE(PPERSON) :: PT(5)
    INTEGER :: I
    FORALL(I=1:5)
        PT(I)%P=>A(I)
    ENDFORALL
    CALL SORT(PT)
    DO I=1,5
        WRITE(*,"(A5,2F10.1)") PT(I)%P
    ENDDO
   STOP

ENDPROGRAM