vertpr.f90 File Reference

Print vertical. More...

Go to the source code of this file.

Functions/Subroutines
subroutine	pzvert (n, x)
	Print vertical.
subroutine	pivert (n, list)
	Vertical print of integer data.
subroutine	pfvert (n, x)
	Vertical print of floating point data.
subroutine	psvert (xa, xb)
	Print scale.

Detailed Description

Print vertical.

Author

Volker Blobel, University Hamburg, 2005-2009 (initial Fortran77 version)

Claus Kleinwort, DESY (maintenance and developement)

Copyright

Copyright (c) 2009 - 2015 Deutsches Elektronen-Synchroton, Member of the Helmholtz Association, (DESY), HAMBURG, GERMANY

This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details.

You should have received a copy of the GNU Library General Public License along with this program (see the file COPYING.LIB for more details); if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

Definition in file vertpr.f90.

Function/Subroutine Documentation

pfvert()

subroutine pfvert	(	integer(mpi), intent(in)	n,
		integer(mpi), dimension(n), intent(in)	x
	)

Vertical print of floating point data.

Print in up to 60 columns. Optionally average data.

Parameters

[in]	n	number of floats
[in]	x	array of floats

Definition at line 224 of file vertpr.f90.

    USE mpdef
 
    IMPLICIT NONE
    REAL(mps) :: dsum
    INTEGER(mpi) :: i
    INTEGER(mpi) :: l
    INTEGER(mpi) :: ll
    INTEGER(mpi) :: m
    REAL(mps) :: y(60)
 
    INTEGER(mpi), INTENT(IN)                      :: n
    INTEGER(mpi), INTENT(IN)                      :: x(n)
 
    ll=(n+59)/60 ! compression factor
    m=0
    i=0
20  dsum=0.0
    DO l=1,ll
        IF(i+l <= n) dsum=dsum+x(i+l)
    END DO
    i=i+ll
    m=m+1
    y(m)=real(dsum,mps)
    IF(i < n) GO TO 20
    CALL pzvert(m,y)
    RETURN

pivert()

subroutine pivert	(	integer(mpi), intent(in)	n,
		integer(mpi), dimension(n), intent(in)	list
	)

Vertical print of integer data.

Print in up to 60 columns. Optionally average data.

Parameters

[in]	n	number of integers
[in]	list	array of integers

Definition at line 184 of file vertpr.f90.

    USE mpdef
 
    IMPLICIT NONE
    INTEGER(mpi) :: i
    INTEGER(mpi) :: l
    INTEGER(mpi) :: ll
    INTEGER(mpi) :: m
    INTEGER(mpi) :: nhist
 
    INTEGER(mpi), INTENT(IN)                      :: n
    INTEGER(mpi), INTENT(IN)                      :: list(n)
 
    
    REAL(mps) :: y(60)
    
    SAVE
    !     ...
    ll=(n+59)/60 ! compression factor
    m=0
    i=0
10  nhist=0
    DO l=1,ll
        IF(i+l <= n) nhist=nhist+list(i+l)
    END DO
    i=i+ll
    m=m+1
    y(m)=nhist
    IF(i < n) GO TO 10
    CALL pzvert(m,y)
    RETURN

psvert()

subroutine psvert	(	real(mps), intent(in)	xa,
		real(mps), intent(in)	xb
	)

Print scale.

Parameters

[in]	xa	lower bound of range
[in]	xb	upper bound of range

Definition at line 258 of file vertpr.f90.

    USE mpdef
 
    IMPLICIT NONE
    INTEGER(mpi) :: i
    REAL(mps) :: xc
    !     print scale from XA ... XB
 
 
    REAL(mps), INTENT(IN)                         :: xa
    REAL(mps), INTENT(IN)                         :: xb
    REAL(mps) :: sc(7)
    xc=xb
    DO i=1,7
        sc(i)=(real(7-i,mps)*xa+real(i-1,mps)*xc)/6.0
    END DO
    WRITE(*,101) sc
101 FORMAT(3x,7g10.3)
    RETURN

pzvert()

subroutine pzvert	(	integer(mpi), intent(in)	n,
		real(mps), dimension(n), intent(in)	x
	)

Print vertical.

Print the array X of dimension N (MAX 120) in 6 lines.

Parameters

[in]	n	number of numbers
[in]	x	array of numbers

Definition at line 35 of file vertpr.f90.

    USE mpdef
 
    IMPLICIT NONE
    INTEGER(mpi) :: i
    INTEGER(mpi) :: i1
    INTEGER(mpi) :: i2
    INTEGER(mpi) :: ia
    INTEGER(mpi) :: ij
    INTEGER(mpi) :: im
    INTEGER(mpi) :: in
    INTEGER(mpi) :: iz
    INTEGER(mpi) :: j
    INTEGER(mpi) :: jl
    INTEGER(mpi) :: jm
    INTEGER(mpi) :: ke
    INTEGER(mpi) :: kl
    INTEGER(mpi) :: kn
    INTEGER(mpi) :: lc
    INTEGER(mpi) :: m
    INTEGER(mpi) :: mx
    REAL(mps) :: fac
    REAL(mps) :: xm
    !
 
    INTEGER(mpi), INTENT(IN)                      :: n
    REAL(mps), INTENT(IN)                         :: x(n)
    INTEGER(mpi), PARAMETER :: nn=6
 
    CHARACTER (LEN=66):: px(10)
    CHARACTER (LEN=66)::ch(10)*1
    SAVE
    DATA ch/'0','1','2','3','4','5','6','7','8','9'/
    !     ...
    IF(n <= 0) RETURN
    jm=0
    DO i=1,10
        px(i)=' '
    END DO
 
    m=min(60,n)
    jl=0
    xm=0.0
    DO j=1,m
        IF(abs(x(j)) > xm) THEN
            xm=abs(x(j))
            mx=j                             ! index of max
        END IF
        IF(x(j) < 0.0) px(1)(6+j:6+j)='-'  ! negative columns
        IF(x(j) /= 0.0) jl=j                ! last non-zero column
    END DO
    IF(xm == 0.0.OR.jl <= 0) RETURN      ! empty array
    jl=60
 
    kn=min(6,max(2,iabs(nn)))
    ke=int(log10(xm*1.0001),mpi)
    IF(xm < 1.0) ke=ke-1
22  fac=10.0**(kn-1-ke)
    ij=nint(fac*xm,mpi)
    IF(ij >= 10**kn) THEN
        ke=ke+1
        GO TO 22
    END IF
    ia=2+kn
 
    DO j=1,jl
        ij=nint(fac*abs(x(j)),mpi)   ! convert to integer
        im=0
        IF(ij /= 0) THEN
            DO i=1,kn
                IF(ij /= 0) THEN
                    in=mod(ij,10)   ! last digit
                    ij=ij/10        ! reduce
                    IF(in /= 0.AND.im == 0) im=ia-i+1
                    px(ia-i)(6+j:6+j)=ch(in+1)
                END IF
            END DO
        END IF
        jm=max(im,jm)
    END DO
 
    kl=ke
50  IF(ke >= kn) THEN
        ke=ke-3
        GO TO 50
    END IF
55  IF(ke < 0) THEN
        ke=ke+3
        GO TO 55
    END IF
 
    in=ke+2                          ! exponent
    iz=kl-ke
    px(in)(6:6)='.'
    px(in)(1:1)='E'
    IF(iz < 0) THEN
        px(in)(2:2)='-'
        iz=-iz
    END IF
    i1=iz/10                         ! insert exponent
    i2=mod(iz,10)
    px(in)(3:3)=ch(i1+1)
    px(in)(4:4)=ch(i2+1)
    jm=min(2+kn,jm)
    jm=max(in+1,jm)
    DO j=1,jl    ! '0' for small nonzero values
        IF(x(j) /= 0.0.AND.px(jm-1)(6+j:6+j) == ' ') px(jm-1)(6+j:6+j)='0'
    END DO
    DO i=jm,8
        px(i)=' '
    END DO
 
    DO j=1,((jl+9)/10)*10            ! index line below
        IF(px(jm-1)(6+j:6+j) == ' ') px(jm-1)(6+j:6+j)='_'
        IF(mod(j,2) /= 1) THEN
            i=mod(j,10)+1
            px(jm+1)(6+j:6+j)=ch(i)      ! last digit of even bin numbers
            IF(i == 1) THEN              ! ten'th column
                i=mod(j/10,10)+1
                px(jm)(6+j:6+j)=ch(i)
      
            END IF
        END IF
    END DO
 
    DO j=1,jl
        IF(x(j) == x(mx)) THEN
            px(jm)(6+j:6+j)='*'          ! * in max bin
        END IF
    END DO
 
    jm=jm+1
    IF(nn < 0) jm=jm-2              ! no index line
    lc=((jl+9)/10)*10+6
    DO j=1,jm
        WRITE(*,*)  px(j)(1:lc)       ! print
    !       WRITE(*,101)  PX(J)(1:LC)       ! print
    END DO
    RETURN
!  101 FORMAT(A)