WRITECHARSF Subroutine

public subroutine WRITECHARSF(IUNIT, CHARS, NROT, STR, LCOMP, LREAL)

Arguments

Type IntentOptional Attributes Name
integer :: IUNIT
complex(kind=dp) :: CHARS(NROT)
integer :: NROT
character(len=6) :: STR
logical :: LCOMP
logical :: LREAL

Contents

Source Code


Source Code

    SUBROUTINE WRITECHARSF(IUNIT, CHARS, NROT, STR, LCOMP, LREAL)
        IMPLICIT NONE
        INTEGER IUNIT, NROT
        complex(dp) CHARS(NROT)
        INTEGER J
        CHARACTER(6) STR
        LOGICAL LCOMP, LREAL
        write(IUNIT, "(A6,A)", advance='no') STR, ":   "
        DO J = 1, NROT
            IF (LCOMP) THEN
                IF (LREAL) THEN
                    write(IUNIT, "(A,2G16.9,A)", advance='no') "(", &
                        NINT(REAL(CHARS(J)) * 1000) / 1000.0_dp, &
                        NINT(AIMAG(CHARS(J)) * 1000) / 1000.0_dp &
                        , ")"
                ELSE
                    write(IUNIT, "(A,2F6.3,A)", advance='no') "(", CHARS(J), ")"
                end if
            ELSE
                IF (ABS(AIMAG(CHARS(J))) > 1.0e-2_dp) THEN
!   write in terms of I.
                    IF (LREAL) THEN
                        write(IUNIT, "(G14.9,A)", advance='no') CHARS(J), " "
                    ELSE
                        IF (ABS(AIMAG(CHARS(J)) + 1.0_dp) < 1.0e-2_dp) THEN
                            write(IUNIT, "(A)", advance='no') " -I "
                        else if (ABS(AIMAG(CHARS(J)) - 1.0_dp) < 1.0e-2_dp) THEN
                            write(IUNIT, "(A)", advance='no') "  I "
                        ELSE
                            write(IUNIT, "(I2,A)", advance='no') NINT(AIMAG(CHARS(J))), "I "
                        end if
                    end if
                ELSE
                    IF (LREAL) THEN
                        write(IUNIT, "(G21.9)", advance='no') REAL(CHARS(J)), "    "
                    ELSE
                        write(IUNIT, "(I3)", advance='no') NINT(REAL(CHARS(J)))
                    end if
                end if
            end if
        end do
        write(IUNIT, *)
    END SUBROUTINE WRITECHARSF