All pastes #576210 Raw Edit

Unnamed

public text v1 · immutable
·published 2007-06-19 12:14 UTC
rendered paste body
! XxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXx
! Function similar to STRLEN but meant for INTEGERs
!
! USAGE: VARIABLE = INTLEN(NUMBER)
! XxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXx
    INTEGER FUNCTION INTLEN(I) 
        INTEGER, INTENT(IN) :: I 
        INTEGER :: TEMP, LCTL
        D = 0
        TEMP = I 
        FLOOP: DO LCTL=1,10,1 
            TEMP = TEMP / 10    
            D = D + 1
            IF (TEMP .EQ. 0) THEN
                EXIT
            END IF
        END DO FLOOP
        INTLEN = D
    END FUNCTION INTLEN
! XxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxX
! Extracts a value stored in a matrix so that it could be used with
! 0 rank variables (non-matrixes)
! 
! USAGE: VARIABLE = EX(MATRIX, INDEX) 
! XxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxX
    INTEGER FUNCTION EX(I, IND)
	INTEGER, DIMENSION(:), INTENT(IN) :: I
	INTEGER, DIMENSION(1:SIZE(I)) :: D
	CALL INIT(D,1)
	EX = DOT_PRODUCT(I(IND:IND),D(IND:IND))
    END FUNCTION EX	
! XxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXx
! Helper subroutine
! XxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXxXx
    SUBROUTINE INIT (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 INIT
END PROGRAM MERGEA