All pastes #536260 Raw Edit

Untitled

public text v1 · immutable
·published 2007-06-04 10:09 UTC
rendered paste body
PROGRAM MERGEA
    INTEGER :: LCTL
    INTEGER, DIMENSION(1:7) :: ARR
    LOOP: DO LCTL=1,SIZE(ARR),1
        ARR(LCTL:LCTL) = LCTL
    END DO LOOP
    WRITE(*,*) MARR_I(ARR)
    CONTAINS
! XxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXx
    INTEGER FUNCTION MARR_I (AR1) 
        INTEGER, INTENT(IN), DIMENSION(:) :: AR1
        INTEGER, DIMENSION(1:SIZE(AR1)) :: DUMMY
        INTEGER :: LCTL, TEMP, CUR, ASIZE, ASIZET, ST
        ASIZE = SIZE(AR1)
        ASIZET = ASIZE
        ASIZET = ASIZET - 1
        CALL IDUMMY(DUMMY, 1)
        MARR_I = 0
        TEMP = 0
        ST = 0
        FLOOP: DO LCTL=1,ASIZE, 1
            CUR = DOT_PRODUCT(DUMMY(LCTL:LCTL), AR1(LCTL:LCTL))
            IF( CUR .EQ. 0) THEN
                ! do nothing :)
            ELSE
                IF(LCTL .EQ. ASIZE) THEN
                    WRITE(*,*) MARR_I
                    WRITE(*,*) C
                    MARR_I = MARR_I + C
                    WRITE(*,*) LCTL
                    EXIT
                ELSE
                    MARR_I = MARR_I + CUR * 10**ASIZET
                END IF
            END IF
            ASIZET = ASIZET - 1
        END DO FLOOP
    END FUNCTION MARR_I

! XxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXx
    SUBROUTINE IDUMMY (AR1, VAL)
        INTEGER, INTENT(IN) :: VAL
        INTEGER, INTENT(INOUT), DIMENSION(:) :: AR1
        INTEGER :: LCTL          
        FLOOP: DO LCTL=1,SIZE(AR1), 1
            AR1(LCTL:LCTL) = VAL
        END DO FLOOP
    END SUBROUTINE IDUMMY
END PROGRAM MERGEA