text:
C Copyright(C) 1999-2020 National Technology & Engineering Solutions
C of Sandia, LLC (NTESS).  Under the terms of Contract DE-NA0003525 with
C NTESS, the U.S. Government retains certain rights in this software.
C
C See packages/seacas/LICENSE for details

C=======================================================================
      SUBROUTINE MUNNPS (NUMNPS, ISTAT, LNPSNL, LNPSDF,
     &   IDNPS, NNNPS, IXNNPS, LTNNPS, FACNPS,
     &   LTNX, FACX, IXNPS, NNX, ISCR, NAMSCR, NAME)
C=======================================================================

C   --*** MUNNPS *** (GJOIN) Compress and rearrange nodal point sets
C   --   Written by Amy Gilkey - revised 02/25/88
C   --
C   --MUNNPS processes the nodal point sets according to the set status.
C   --Sets may be combined or deleted.
C   --
C   --Parameters:
C   --   NUMNPS - IN/OUT - the number of nodal point sets
C   --   ISTAT - IN - the status of each set:
C   --      0 = same
C   --      - = delete
C   --      n = combine with set n
C   --   LNPSNL - IN/OUT - the length of the nodal point sets node list
C   --   LNPSDF - IN/OUT - the length of the nodal point dist.fact. list
C   --   IDNPS - IN/OUT - the nodal point set ID for each set
C   --   NNNPS - IN/OUT - the number of nodes for each set
C   --   IXNNPS - IN/OUT - the index of the first node for each set
C   --   LTNNPS - IN/OUT - the nodes for all sets
C   --   FACNPS - IN/OUT - the distribution factors for all sets
C   --   LTNX - SCRATCH - sized to hold the set nodes
C   --   FACX - SCRATCH - sized to hold the set factors
C   --   IXNPS - SCRATCH - size = NUMNPS
C   --   NNX - SCRATCH - size = NUMNPS
C   --   ISCR - SCRATCH - size = NUMNPS

      include 'gp_params.blk'
      include 'gp_namlen.blk'

      INTEGER ISTAT(*)
      INTEGER IDNPS(*)
      INTEGER NNNPS(*)
      INTEGER IXNNPS(*)
      INTEGER LTNNPS(*), LTNX(*)
      REAL FACNPS(*), FACX(*)
      INTEGER IXNPS(*)
      INTEGER NNX(*)
      INTEGER ISCR(*)
      CHARACTER*(MXSTLN) NAMSCR(*)
      CHARACTER*(maxnam) NAME(*)

      IF (NUMNPS .LE. 0) RETURN

      IF (LNPSDF .NE. LNPSNL .AND. LNPSDF .NE. 0) then
        call prterr('ERROR',
     *    'Length of nodeset dist. fact. list must be zero or '//
     *    'equal to length of nodeset node list. It is neither.')
      end if

      JNPS = 0
      JNN0 = 0
      DO 120 INPS = 1, NUMNPS

         IF (ISTAT(INPS) .EQ. 0) THEN
            NINSET = 1
            ISCR(NINSET) = INPS
         ELSE IF (ISTAT(INPS) .EQ. INPS) THEN
            CALL GETALL (INPS, NUMNPS, ISTAT, NINSET, ISCR)
         ELSE
            NINSET = 0
         END IF

         IF (NINSET .GT. 0) THEN
            JNPS = JNPS + 1
            IXNPS(JNPS) = INPS
            NNX(JNPS) = 0
            JOLD = JNN0+1
         END IF

         DO 110 ISET = 1, NINSET
            N = ISCR(ISET)
            JLEN = JNN0+1 - JOLD
            INN0 = IXNNPS(N) - 1
C ... Find max node number in the LTNX(JOLD:JOLD+JLEN) array.
            maxnod = 0
            do 90 i=jold, jold+jlen-1
              if (ltnx(i) .gt. maxnod) maxnod = ltnx(i)
 90         continue

            NNEW = 0
C ... Goal is to minimize the number of calls to locint.
C     More memory intensive solution may be to index all nodes
C     contained in ltnx(jold,jold+jlen) in
C     a large array and see if ltnnps(inno+i) is indexed....

            DO 100 I = 1, NNNPS(N)
               IF (JLEN .EQ. 0 .OR. maxnod .lt. LTNNPS(INN0+I) .or.
     *          LOCINT (LTNNPS(INN0+I), JLEN, LTNX(JOLD)) .EQ. 0)
     &            THEN
                  NNEW = NNEW + 1
                  LTNX(JNN0+NNEW) = LTNNPS(INN0+I)
                  if (lnpsdf .ne. 0) then
                    FACX(JNN0+NNEW) = FACNPS(INN0+I)
                  end if
               END IF
  100       CONTINUE
            NNX(JNPS) = NNX(JNPS) + NNEW
            JNN0 = JNN0 + NNEW
  110    CONTINUE
  120 CONTINUE

      CALL ORDIX (JNPS, IXNPS, NUMNPS, IDNPS, ISCR, IDNPS)
      CALL ORDSTR(JNPS, IXNPS, NUMNPS, NAME, NAMSCR)
      CALL MOVINT (JNPS, NNX, NNNPS)
      NUMNPS = JNPS
      JNN = 1
      DO 130 INPS = 1, NUMNPS
         IXNNPS(INPS) = JNN
         JNN = JNN + NNNPS(INPS)
  130 CONTINUE
      LNPSNL = JNN - 1

      CALL MOVINT (LNPSNL, LTNX, LTNNPS)
      if (lnpsdf .ne. 0) then
        CALL MOVREA (LNPSNL, FACX, FACNPS)
        lnpsdf = lnpsnl
      end if

      RETURN
      END

max_stars_repo_name: jschueller/seacas

max_issues_repo_name: jschueller/seacas

max_forks_repo_name: jschueller/seacas


text:
module gauss_mod
    use, intrinsic :: iso_fortran_env, only : dp => REAL64
    use :: quad_mod
    implicit none

    private
    type, public, extends(quad_type) :: gen_gauss_type
        private
        real(kind=dp) :: precision
        real(kind=dp), dimension(:), allocatable :: ws, xs
    contains
        private
        procedure, public :: init_gen_gauss
        procedure :: init_vectors
        procedure, public :: integrate
        procedure, public :: print_params
    end type gen_gauss_type

    real(kind=dp), parameter :: pi = 3.1415926535897932384626_dp, &
                                default_precision = 1.0e-10_dp

    integer, parameter :: nr_points = 10

    type, public, extends(gen_gauss_type) :: gauss_type
    contains
        private
        procedure, public :: init => init_gauss10
    end type gauss_type

contains

    subroutine init_gauss10(self)
        implicit none
        class(gauss_type), intent(inout) :: self
        call self%init_vectors(nr_points)
        self%ws(1)  = 0.2955242247147529; self%xs(1)  = -0.1488743389816312
        self%ws(2)  = 0.2955242247147529; self%xs(2)  =  0.1488743389816312
        self%ws(3)  = 0.2692667193099963; self%xs(3)  = -0.4333953941292472
        self%ws(4)  = 0.2692667193099963; self%xs(4)  =  0.4333953941292472
        self%ws(5)  = 0.2190863625159820; self%xs(5)  = -0.6794095682990244
        self%ws(6)  = 0.2190863625159820; self%xs(6)  =  0.6794095682990244
        self%ws(7)  = 0.1494513491505806; self%xs(7)  = -0.8650633666889845
        self%ws(8)  = 0.1494513491505806; self%xs(8)  =  0.8650633666889845
        self%ws(9)  = 0.0666713443086881; self%xs(9)  = -0.9739065285171717
        self%ws(10) = 0.0666713443086881; self%xs(10) =  0.9739065285171717
    end subroutine init_gauss10

    subroutine init_vectors(self, n, stat)
        implicit none
        class(gen_gauss_type), intent(inout) :: self
        integer, intent(in) :: n
        integer, intent(inout), optional :: stat
        integer :: istat
        allocate(self%xs(n), stat=istat)
        if (istat /= 0) then
            if (present(stat)) then
                stat = istat
                return
            else
                stop 'can not allocate x values'
            end if
        end if
        allocate(self%ws(n), stat=istat)
        if (istat /= 0) then
            if (present(stat)) then
                stat = istat
                return
            else
                stop 'can not allocate w values'
            end if
        end if
    end subroutine init_vectors

    subroutine init_gen_gauss(self, n, precision, stat)
        implicit none
        class(gen_gauss_type), intent(inout) :: self
        integer, intent(in) :: n
        real(kind=dp), intent(in), optional :: precision
        integer, intent(inout), optional :: stat
        integer :: istat, i
        real(kind=dp) :: z, z1, pp
        if (present(precision)) then
            self%precision = precision
        else
            self%precision = default_precision
        end if
        call self%init_vectors(n)
        do i = 1, n
            z = cos(pi*(i - 0.25_dp)/(n + 0.5_dp))
            call compute_zs(z, z1, pp, n)
            do while ((z - z1) > self%precision)
                call compute_zs(z, z1, pp, n)
            end do
            self%xs(i) = -z
            self%ws(i) = 2.0_dp/((1.0_dp - z**2)*pp**2)
        end do

    contains

        subroutine compute_zs(z, z1, pp, n)
            implicit none
            real(kind=dp), intent(inout) :: z
            real(kind=dp), intent(out) :: z1, pp
            integer, intent(in) :: n
            integer :: i
            real(kind=dp) :: p1, p2, p3
            p1 = 1.0_dp
            p2 = 0.0_dp
            do i = 1, n
                p3 = p2
                p2 = p1
                p1 = ((2*i - 1)*z*p2 - (i - 1)*p3)/i
            end do
            pp = n*(z*p1 - p2)/(z**2 - 1.0_dp)
            z1 = z
            z = z1 - p1/pp
        end subroutine compute_zs

    end subroutine init_gen_gauss

    function integrate(self, f, a, b) result(r)
        use :: quad_func_interface
        implicit none
        class(gen_gauss_type), intent(in) :: self
        procedure(quad_func_type) :: f
        real(kind=dp), intent(in) :: a, b
        real(kind=dp) :: r
        real(kind=dp) :: x, delta
        integer :: i
        x = 0.5*(a + b)
        delta = 0.5*(b - a)
        r = 0.0_dp
        do i = 1, size(self%xs)
            r = r + self%ws(i)*f(x + self%xs(i)*delta)
        end do
        r = r*delta
    end function integrate

    subroutine print_params(self)
        implicit none
        class(gen_gauss_type), intent(in) :: self
        integer :: i
        do i = 1, size(self%xs)
            print '(2F20.15)', self%xs(i), self%ws(i)
        end do
    end subroutine print_params

end module gauss_mod

max_stars_repo_name: Gjacquenot/training-material

max_issues_repo_name: Gjacquenot/training-material

max_forks_repo_name: Gjacquenot/training-material


text:
C     ------------------------------------------------------------------
      SUBROUTINE FANTADIPO(ATOMIPTR,ATOMJPTR,ATOMKPTR,ATOMLPTR,ATOMMPTR,
     &                     ATOMNPTR,ATOMILST,ATOMJLST,ATOMKLST,ATOMLLST,
     &                     ATOMMLST,ATOMNLST,XRDCOBS,XRDCERR,
     &                     NCLASS,NOMEFILE)
C     ------------------------------------------------------------------
C     Fits residual dipolar couplings tensor on a given structure
C
C     By Gabriele Cavallaro, Andrea Giachetti and Giacomo Parigi (2003)
C     ------------------------------------------------------------------
      IMPLICIT NONE

      INCLUDE  "cns.inc"
      INCLUDE  "mtf.inc"
      INCLUDE  "coord.inc"
      INCLUDE  "numbers.inc"
      INCLUDE  "deriv.inc"
      INCLUDE  "xdipo_rdc.inc"
      INCLUDE  "consta.inc"
      INCLUDE  "fantaxplor.inc"
      INCLUDE  'heap.inc'

      CHARACTER NOMEFILE*132
      DOUBLE PRECISION APARA,APERP
      COMMON /FRUN/APERP,APARA
      INTEGER FDSWITCH,FDSAVE,FDERR
      COMMON /FDPARAM/FDSWITCH,FDSAVE,FDERR
      INTEGER FDVIOLS
      COMMON /DVIOL/FDVIOLS
      DOUBLE PRECISION FENERGTOT
      COMMON /FENERG/FENERGTOT
      DOUBLE PRECISION FDENT(20,2000),FDPER(20,2000),FDPAR(20,2000),
     &                 FDIPOE(20,2000)
      INTEGER DCONTSAVE(20)
      COMMON /FDMEDIA/FDENT,FDPER,FDPAR,FDIPOE,DCONTSAVE
      DOUBLE PRECISION DIPOE
      COMMON /DIPOENERGY/ DIPOE
      DOUBLE COMPLEX DUMMY2
      INTEGER ATOMIPTR(*),ATOMJPTR(*),ATOMKPTR(*)
      INTEGER ATOMLPTR(*),ATOMMPTR(*),ATOMNPTR(*)
      INTEGER ATOMILST(*),ATOMJLST(*),ATOMKLST(*)
      INTEGER ATOMLLST(*),ATOMMLST(*),ATOMNLST(*)
      INTEGER COUNT,MM,NN,I,J,K,L,NA,M,N,CLASS,NORES
      INTEGER NCLASS,NNCO,NNCC
      DOUBLE PRECISION XRDCOBS(*),XRDCERR(*)
      DOUBLE PRECISION XI,XJ,XK,XL,XM,XN,YI,YJ,YK,YL,YM,YN,
     &                 ZI,ZJ,ZK,ZL,ZM,ZN
      DOUBLE PRECISION XFA(1000),YFA(1000),ZFA(1000),XMFA(1000),
     &                 YMFA(1000),ZMFA(1000),ERRFA(1000),OBSFA(1000),
     &                 WPROT(1000)
C     ------------------------------------------------------------------
C     CLASS must remain this during the cycle of variables exchange.
C     The class is defined by NCLASS.
C     ------------------------------------------------------------------
      CLASS=1
      NNCO=0
      NNCC=0
      COUNT=0

      PRINT*,'This is FANTALIN for RDC.'
      PRINT*,'RDCNUM is:',RDCNUM

      DO WHILE(COUNT.LT.RDCNUM)
         COUNT=COUNT+1
         DO WHILE ((XRDCASSNDX(CLASS).LT.COUNT).OR.
     &             (XRDCASSNDX(CLASS).EQ.0))
            CLASS=CLASS+1
         END DO
         IF (XRDCASSNDX(CLASS).EQ.XRDCASSNDX(CLASS-1)) THEN
             COUNT=COUNT-1
         ENDIF

         IF (NCLASS.EQ.CLASS) THEN
             NNCO=NNCO+1
             I=ATOMIPTR(COUNT)+1
             J=ATOMJPTR(COUNT)+1
             K=ATOMKPTR(COUNT)+1
             L=ATOMLPTR(COUNT)+1
             XI=X(ATOMILST(I))
             XJ=X(ATOMJLST(J))
             XK=X(ATOMKLST(K))
             XL=X(ATOMLLST(L))
             YI=Y(ATOMILST(I))
             YJ=Y(ATOMJLST(J))
             YK=Y(ATOMKLST(K))
             YL=Y(ATOMLLST(L))
             ZI=Z(ATOMILST(I))
             ZJ=Z(ATOMJLST(J))
             ZK=Z(ATOMKLST(K))
             ZL=Z(ATOMLLST(L))
             OBSFA(NNCO)=XRDCOBS(COUNT)
             ERRFA(NNCO)=XRDCERR(COUNT)
         END IF

         DO MM=ATOMMPTR(COUNT)+1,ATOMMPTR(COUNT+1)
            DO NN=ATOMNPTR(COUNT)+1,ATOMNPTR(COUNT+1)
               IF (NCLASS.EQ.CLASS) THEN
                   NNCC=NNCC+1
                   XMFA(NNCC)=X(ATOMMLST(MM))
                   XFA(NNCC)=X(ATOMNLST(NN))
                   YMFA(NNCC)=Y(ATOMMLST(MM))
                   YFA(NNCC)=Y(ATOMNLST(NN))
                   ZMFA(NNCC)=Z(ATOMMLST(MM))
                   ZFA(NNCC)=Z(ATOMNLST(NN))
                   NORES=ATOMNLST(NN)
                   NRESIDFA(NNCC)=RESID(NORES)
                   NRESFA(NNCC)=RES(NORES)
                   NTYPEFA(NNCC)=TYPE(NORES)
               END IF
            END DO
         END DO
      END DO

      IF (NNCC.EQ.NNCO) THEN
          CALL FANTALINEXE(XFA,YFA,ZFA,XMFA,YMFA,ZMFA,NNCO,OBSFA,ERRFA,
     &                     0,NOMEFILE,WPROT,0,DIPFLG)
          PRINT*,'FDERR is=',FDERR
          IF (FDERR.EQ.1) THEN
              CALL FANTAERRORE(XFA,YFA,ZFA,XMFA,YMFA,ZMFA,NNCO,OBSFA,
     &                         ERRFA,0,DIPFLG)
          END IF
      ELSE
          PRINT*,'Error in atom count...'
      END IF

      PRINT*,'FDSWITCH is:',FDSWITCH
      IF (FDSWITCH.EQ.1) THEN
          XRDCCOEF1(NCLASS)=APARA
          XRDCCOEF2(NCLASS)=APERP
          PRINT*,'For class:',NCLASS
          PRINT*,'New value for A1 =',APARA
          PRINT*,'New value for A2 =',APERP
      END IF

      IF (FDSAVE.EQ.1) THEN
          DCONTSAVE(NCLASS)=DCONTSAVE(NCLASS)+1
          FDENT(NCLASS,DCONTSAVE(NCLASS))=FENERGTOT
          FDIPOE(NCLASS,DCONTSAVE(NCLASS))=DIPOE
          FDPAR(NCLASS,DCONTSAVE(NCLASS))=APARA
          FDPER(NCLASS,DCONTSAVE(NCLASS))=APERP
          PRINT*,'XDIPO_RDC energy =',DIPOE
          PRINT*,'Total energy =',FENERGTOT
          PRINT*,'DCONTSAVE is:',DCONTSAVE(NCLASS)
      END IF

      CALL DECLAR('DCHIAX','DP',' ', DUMMY2,APARA)
      CALL DECLAR('DCHIRH','DP',' ', DUMMY2,APERP)

      RETURN
      END
C     ------------------------------------------------------------------
      SUBROUTINE FANTADIPOMEDIA (FMA,PERC)
C     ------------------------------------------------------------------
C     Averages tensor parameters on a given sub-ensemble of structures
C
C     By Gabriele Cavallaro, Andrea Giachetti and Giacomo Parigi (2003)
C     ------------------------------------------------------------------
      IMPLICIT NONE
      DOUBLE PRECISION VETE(2,2000),VETT(3,2000)
      DOUBLE PRECISION FDENT(20,2000),FDPER(20,2000),FDPAR(20,2000),
     &                 FDIPOE(20,2000)
      COMMON /FDMEDIA/ FDENT,FDPER,FDPAR,FDIPOE,DCONTSAVE
      INTEGER DCONTSAVE(20)
      INTEGER FMA,COUNT,CB,NUM,COUNT1,CONFPRE
      DOUBLE PRECISION PERC
      DOUBLE PRECISION M1PAR,M1PER,DEVPAR
      DOUBLE COMPLEX DUMMY2
C     ------------------------------------------------------------------
C     Through FMA the class on which the average must be done is passed.
C     If it is zero, all the counters are reset.
C     ------------------------------------------------------------------
      IF (FMA.EQ.0) THEN
          DO COUNT=1,19
             DCONTSAVE(COUNT)=0
          END DO
          PRINT*,'Mean vectors reset.'
      ELSE
C     ------------------------------------------------------------------
C     The best are selected
C     ------------------------------------------------------------------
          DO COUNT=1,DCONTSAVE(FMA)
             VETE(1,COUNT)=0
          END DO

          DO COUNT=1,DCONTSAVE(FMA)
            NUM=DCONTSAVE(FMA)
            DO WHILE (VETE(1,NUM).EQ.1)
               NUM=NUM-1
            END DO
            DO COUNT1=1,DCONTSAVE(FMA)-1
               IF ((FDENT(FMA,COUNT1).LE.FDENT(FMA,NUM)).AND.
     &             (VETE(1,COUNT1).EQ.0.0)) THEN
                    NUM=COUNT1
               END IF
            END DO
            PRINT*,'NUM is:',NUM
            VETE(1,NUM)=1
            VETE(2,COUNT)=FDENT(FMA,NUM)
            VETT(1,COUNT)=FDPAR(FMA,NUM)
            VETT(2,COUNT)=FDPER(FMA,NUM)
         END DO

         CONFPRE=NINT((DBLE(DCONTSAVE(FMA))*(PERC/100.)))
         IF (CONFPRE.EQ.0) THEN
             CONFPRE=1
         END IF
         PRINT*,'CONFPRE is:',CONFPRE
         PRINT*,'PERC is:',PERC
         PRINT*,'DBLE(CONTSAVE(FMA)) is:',DBLE(DCONTSAVE(FMA))

         DO COUNT=1,DCONTSAVE(FMA)
            PRINT*,'Number',COUNT,'Energy',VETE(1,COUNT),VETE(2,COUNT)
            PRINT*,'A1',VETT(1,COUNT),' A2',VETT(2,COUNT)
         END DO

         CB=0
         M1PAR=0
         M1PER=0
         DO COUNT=1,CONFPRE
            M1PAR=M1PAR+VETT(1,COUNT)
            M1PER=M1PER+VETT(2,COUNT)
            CB=CB+1
            PRINT*,'A1 =',VETT(1,COUNT),'A2 =',VETT(2,COUNT)
         END DO
         M1PAR=M1PAR/CB
         M1PER=M1PER/CB

         CB=0
         DEVPAR=0
         DO COUNT=1,CONFPRE
            DEVPAR=DEVPAR+(VETT(1,COUNT)-M1PAR)**2
         END DO
         DEVPAR=DEVPAR/CONFPRE
         PRINT*,'Averaged new A1 =',M1PAR
         PRINT*,'Averaged new A2 =',M1PER
         PRINT*,'Standard deviation for new A1 =',SQRT(DEVPAR)

         CALL DECLAR('DCHIAX','DP',' ',DUMMY2,M1PAR)
         CALL DECLAR('DCHIRH','DP',' ',DUMMY2,M1PER)

         END IF

         RETURN
         END

ext: f


text:
module stdlib_io_disp

    use stdlib_kinds, only: sp, dp, qp, &
                            int8, int16, int32, int64, &
                            lk, c_bool

    use stdlib_string_type, only: string_type, char, len
    use stdlib_optval, only: optval
    use stdlib_strings, only: to_string
    use, intrinsic :: iso_fortran_env, only: output_unit
    implicit none
    private

    public :: disp

    interface disp
        module procedure disp_char
        module procedure disp_0_rsp
        module procedure disp_0_rdp
        module procedure disp_0_csp
        module procedure disp_0_cdp
        module procedure disp_0_iint8
        module procedure disp_0_iint16
        module procedure disp_0_iint32
        module procedure disp_0_iint64
        module procedure disp_0_llk
        module procedure disp_0_lc_bool
        module procedure disp_0_tstring_type
        module procedure disp_1_rsp
        module procedure disp_1_rdp
        module procedure disp_1_csp
        module procedure disp_1_cdp
        module procedure disp_1_iint8
        module procedure disp_1_iint16
        module procedure disp_1_iint32
        module procedure disp_1_iint64
        module procedure disp_1_llk
        module procedure disp_1_lc_bool
        module procedure disp_1_tstring_type
        module procedure disp_2_rsp
        module procedure disp_2_rdp
        module procedure disp_2_csp
        module procedure disp_2_cdp
        module procedure disp_2_iint8
        module procedure disp_2_iint16
        module procedure disp_2_iint32
        module procedure disp_2_iint64
        module procedure disp_2_llk
        module procedure disp_2_lc_bool
        module procedure disp_2_tstring_type
    end interface disp

    type(string_type) :: coloum(5) !! 减轻编译体积

contains

    subroutine disp_0_rsp(x, header, unit, brief, format, width, sep)

        real(sp), intent(in) :: x
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        allocate (x_str)
        x_str = string_type(to_string(x, format_))
        write (unit_, "(A)") format_output_string([x_str], width_, brief_, sep_, len(x_str))

    end subroutine disp_0_rsp
    subroutine disp_0_rdp(x, header, unit, brief, format, width, sep)

        real(dp), intent(in) :: x
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        allocate (x_str)
        x_str = string_type(to_string(x, format_))
        write (unit_, "(A)") format_output_string([x_str], width_, brief_, sep_, len(x_str))

    end subroutine disp_0_rdp
    subroutine disp_0_csp(x, header, unit, brief, format, width, sep)

        complex(sp), intent(in) :: x
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        allocate (x_str)
        x_str = string_type(to_string(x, format_))
        write (unit_, "(A)") format_output_string([x_str], width_, brief_, sep_, len(x_str))

    end subroutine disp_0_csp
    subroutine disp_0_cdp(x, header, unit, brief, format, width, sep)

        complex(dp), intent(in) :: x
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        allocate (x_str)
        x_str = string_type(to_string(x, format_))
        write (unit_, "(A)") format_output_string([x_str], width_, brief_, sep_, len(x_str))

    end subroutine disp_0_cdp
    subroutine disp_0_iint8(x, header, unit, brief, format, width, sep)

        integer(int8), intent(in) :: x
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        allocate (x_str)
        x_str = string_type(to_string(x, format_))
        write (unit_, "(A)") format_output_string([x_str], width_, brief_, sep_, len(x_str))

    end subroutine disp_0_iint8
    subroutine disp_0_iint16(x, header, unit, brief, format, width, sep)

        integer(int16), intent(in) :: x
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        allocate (x_str)
        x_str = string_type(to_string(x, format_))
        write (unit_, "(A)") format_output_string([x_str], width_, brief_, sep_, len(x_str))

    end subroutine disp_0_iint16
    subroutine disp_0_iint32(x, header, unit, brief, format, width, sep)

        integer(int32), intent(in) :: x
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        allocate (x_str)
        x_str = string_type(to_string(x, format_))
        write (unit_, "(A)") format_output_string([x_str], width_, brief_, sep_, len(x_str))

    end subroutine disp_0_iint32
    subroutine disp_0_iint64(x, header, unit, brief, format, width, sep)

        integer(int64), intent(in) :: x
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        allocate (x_str)
        x_str = string_type(to_string(x, format_))
        write (unit_, "(A)") format_output_string([x_str], width_, brief_, sep_, len(x_str))

    end subroutine disp_0_iint64
    subroutine disp_0_llk(x, header, unit, brief, format, width, sep)

        logical(lk), intent(in) :: x
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        allocate (x_str)
        x_str = string_type(to_string(x, format_))
        write (unit_, "(A)") format_output_string([x_str], width_, brief_, sep_, len(x_str))

    end subroutine disp_0_llk
    subroutine disp_0_lc_bool(x, header, unit, brief, format, width, sep)

        logical(c_bool), intent(in) :: x
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        allocate (x_str)
        x_str = string_type(to_string(x, format_))
        write (unit_, "(A)") format_output_string([x_str], width_, brief_, sep_, len(x_str))

    end subroutine disp_0_lc_bool
    subroutine disp_0_tstring_type(x, header, unit, brief, format, width, sep)

        type(string_type), intent(in) :: x
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        write (unit_, "(A)") format_output_string([x], width_, brief_, sep_, len(x))

    end subroutine disp_0_tstring_type
    subroutine disp_1_rsp(x, header, unit, brief, format, width, sep)

        real(sp), intent(in) :: x(:)
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str(:)
        type(string_type) :: array_info

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        array_info = array_info_maker(size(x, 1))
        write (unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info))

        allocate (x_str(size(x, 1)))
        do i = 1, size(x, 1)
            x_str(i) = string_type(to_string(x(i), format_))
        end do
        write (unit_, "(*(A))") format_output_string(x_str, width_, brief_, sep_, maxval(len(x_str)))

    end subroutine disp_1_rsp
    subroutine disp_1_rdp(x, header, unit, brief, format, width, sep)

        real(dp), intent(in) :: x(:)
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str(:)
        type(string_type) :: array_info

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        array_info = array_info_maker(size(x, 1))
        write (unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info))

        allocate (x_str(size(x, 1)))
        do i = 1, size(x, 1)
            x_str(i) = string_type(to_string(x(i), format_))
        end do
        write (unit_, "(*(A))") format_output_string(x_str, width_, brief_, sep_, maxval(len(x_str)))

    end subroutine disp_1_rdp
    subroutine disp_1_csp(x, header, unit, brief, format, width, sep)

        complex(sp), intent(in) :: x(:)
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str(:)
        type(string_type) :: array_info

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        array_info = array_info_maker(size(x, 1))
        write (unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info))

        allocate (x_str(size(x, 1)))
        do i = 1, size(x, 1)
            x_str(i) = string_type(to_string(x(i), format_))
        end do
        write (unit_, "(*(A))") format_output_string(x_str, width_, brief_, sep_, maxval(len(x_str)))

    end subroutine disp_1_csp
    subroutine disp_1_cdp(x, header, unit, brief, format, width, sep)

        complex(dp), intent(in) :: x(:)
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str(:)
        type(string_type) :: array_info

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        array_info = array_info_maker(size(x, 1))
        write (unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info))

        allocate (x_str(size(x, 1)))
        do i = 1, size(x, 1)
            x_str(i) = string_type(to_string(x(i), format_))
        end do
        write (unit_, "(*(A))") format_output_string(x_str, width_, brief_, sep_, maxval(len(x_str)))

    end subroutine disp_1_cdp
    subroutine disp_1_iint8(x, header, unit, brief, format, width, sep)

        integer(int8), intent(in) :: x(:)
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str(:)
        type(string_type) :: array_info

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        array_info = array_info_maker(size(x, 1))
        write (unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info))

        allocate (x_str(size(x, 1)))
        do i = 1, size(x, 1)
            x_str(i) = string_type(to_string(x(i), format_))
        end do
        write (unit_, "(*(A))") format_output_string(x_str, width_, brief_, sep_, maxval(len(x_str)))

    end subroutine disp_1_iint8
    subroutine disp_1_iint16(x, header, unit, brief, format, width, sep)

        integer(int16), intent(in) :: x(:)
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str(:)
        type(string_type) :: array_info

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        array_info = array_info_maker(size(x, 1))
        write (unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info))

        allocate (x_str(size(x, 1)))
        do i = 1, size(x, 1)
            x_str(i) = string_type(to_string(x(i), format_))
        end do
        write (unit_, "(*(A))") format_output_string(x_str, width_, brief_, sep_, maxval(len(x_str)))

    end subroutine disp_1_iint16
    subroutine disp_1_iint32(x, header, unit, brief, format, width, sep)

        integer(int32), intent(in) :: x(:)
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str(:)
        type(string_type) :: array_info

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        array_info = array_info_maker(size(x, 1))
        write (unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info))

        allocate (x_str(size(x, 1)))
        do i = 1, size(x, 1)
            x_str(i) = string_type(to_string(x(i), format_))
        end do
        write (unit_, "(*(A))") format_output_string(x_str, width_, brief_, sep_, maxval(len(x_str)))

    end subroutine disp_1_iint32
    subroutine disp_1_iint64(x, header, unit, brief, format, width, sep)

        integer(int64), intent(in) :: x(:)
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str(:)
        type(string_type) :: array_info

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        array_info = array_info_maker(size(x, 1))
        write (unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info))

        allocate (x_str(size(x, 1)))
        do i = 1, size(x, 1)
            x_str(i) = string_type(to_string(x(i), format_))
        end do
        write (unit_, "(*(A))") format_output_string(x_str, width_, brief_, sep_, maxval(len(x_str)))

    end subroutine disp_1_iint64
    subroutine disp_1_llk(x, header, unit, brief, format, width, sep)

        logical(lk), intent(in) :: x(:)
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str(:)
        type(string_type) :: array_info

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        array_info = array_info_maker(size(x, 1))
        write (unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info))

        allocate (x_str(size(x, 1)))
        do i = 1, size(x, 1)
            x_str(i) = string_type(to_string(x(i), format_))
        end do
        write (unit_, "(*(A))") format_output_string(x_str, width_, brief_, sep_, maxval(len(x_str)))

    end subroutine disp_1_llk
    subroutine disp_1_lc_bool(x, header, unit, brief, format, width, sep)

        logical(c_bool), intent(in) :: x(:)
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str(:)
        type(string_type) :: array_info

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        array_info = array_info_maker(size(x, 1))
        write (unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info))

        allocate (x_str(size(x, 1)))
        do i = 1, size(x, 1)
            x_str(i) = string_type(to_string(x(i), format_))
        end do
        write (unit_, "(*(A))") format_output_string(x_str, width_, brief_, sep_, maxval(len(x_str)))

    end subroutine disp_1_lc_bool
    subroutine disp_1_tstring_type(x, header, unit, brief, format, width, sep)

        type(string_type), intent(in) :: x(:)
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j

        type(string_type) :: array_info

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        array_info = array_info_maker(size(x, 1))
        write (unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info))

        write (unit_, "(*(A))") format_output_string(x, width_, brief_, sep_, maxval(len(x)))

    end subroutine disp_1_tstring_type
    subroutine disp_2_rsp(x, header, unit, brief, format, width, sep)

        real(sp), intent(in) :: x(:, :)
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_, max_elem_len
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str(:, :)
        type(string_type) :: array_info

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        array_info = array_info_maker(size(x, 1), size(x, 2))
        write (unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info))

        allocate (x_str(size(x, 1), size(x, 2)))
        do i = 1, size(x, 1)
            do j = 1, size(x, 2)
                x_str(i, j) = string_type(to_string(x(i, j), format_))
            end do
        end do

        max_elem_len = maxval(len(x_str))

        if (brief_ .and. size(x, 1) > 5) then
            do i = 1, 3
                write (unit_, "(*(A))") format_output_string(x_str(i, :), width_, brief_, sep_, max_elem_len)
            end do

            write (unit_, "(*(A))") format_output_string(coloum(1:merge(size(x, 2), 5, size(x, 2) <= 5)), &
                                                         width_, brief_, sep_, max_elem_len)
            write (unit_, "(*(A))") format_output_string(x_str(size(x, 1), :), width_, brief_, sep_, max_elem_len)

        else
            do i = 1, size(x, 1)
                write (unit_, "(*(A))") format_output_string(x_str(i, :), width_, brief_, sep_, max_elem_len)
            end do
        end if

    end subroutine disp_2_rsp
    subroutine disp_2_rdp(x, header, unit, brief, format, width, sep)

        real(dp), intent(in) :: x(:, :)
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_, max_elem_len
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str(:, :)
        type(string_type) :: array_info

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        array_info = array_info_maker(size(x, 1), size(x, 2))
        write (unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info))

        allocate (x_str(size(x, 1), size(x, 2)))
        do i = 1, size(x, 1)
            do j = 1, size(x, 2)
                x_str(i, j) = string_type(to_string(x(i, j), format_))
            end do
        end do

        max_elem_len = maxval(len(x_str))

        if (brief_ .and. size(x, 1) > 5) then
            do i = 1, 3
                write (unit_, "(*(A))") format_output_string(x_str(i, :), width_, brief_, sep_, max_elem_len)
            end do

            write (unit_, "(*(A))") format_output_string(coloum(1:merge(size(x, 2), 5, size(x, 2) <= 5)), &
                                                         width_, brief_, sep_, max_elem_len)
            write (unit_, "(*(A))") format_output_string(x_str(size(x, 1), :), width_, brief_, sep_, max_elem_len)

        else
            do i = 1, size(x, 1)
                write (unit_, "(*(A))") format_output_string(x_str(i, :), width_, brief_, sep_, max_elem_len)
            end do
        end if

    end subroutine disp_2_rdp
    subroutine disp_2_csp(x, header, unit, brief, format, width, sep)

        complex(sp), intent(in) :: x(:, :)
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_, max_elem_len
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str(:, :)
        type(string_type) :: array_info

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        array_info = array_info_maker(size(x, 1), size(x, 2))
        write (unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info))

        allocate (x_str(size(x, 1), size(x, 2)))
        do i = 1, size(x, 1)
            do j = 1, size(x, 2)
                x_str(i, j) = string_type(to_string(x(i, j), format_))
            end do
        end do

        max_elem_len = maxval(len(x_str))

        if (brief_ .and. size(x, 1) > 5) then
            do i = 1, 3
                write (unit_, "(*(A))") format_output_string(x_str(i, :), width_, brief_, sep_, max_elem_len)
            end do

            write (unit_, "(*(A))") format_output_string(coloum(1:merge(size(x, 2), 5, size(x, 2) <= 5)), &
                                                         width_, brief_, sep_, max_elem_len)
            write (unit_, "(*(A))") format_output_string(x_str(size(x, 1), :), width_, brief_, sep_, max_elem_len)

        else
            do i = 1, size(x, 1)
                write (unit_, "(*(A))") format_output_string(x_str(i, :), width_, brief_, sep_, max_elem_len)
            end do
        end if

    end subroutine disp_2_csp
    subroutine disp_2_cdp(x, header, unit, brief, format, width, sep)

        complex(dp), intent(in) :: x(:, :)
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_, max_elem_len
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str(:, :)
        type(string_type) :: array_info

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        array_info = array_info_maker(size(x, 1), size(x, 2))
        write (unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info))

        allocate (x_str(size(x, 1), size(x, 2)))
        do i = 1, size(x, 1)
            do j = 1, size(x, 2)
                x_str(i, j) = string_type(to_string(x(i, j), format_))
            end do
        end do

        max_elem_len = maxval(len(x_str))

        if (brief_ .and. size(x, 1) > 5) then
            do i = 1, 3
                write (unit_, "(*(A))") format_output_string(x_str(i, :), width_, brief_, sep_, max_elem_len)
            end do

            write (unit_, "(*(A))") format_output_string(coloum(1:merge(size(x, 2), 5, size(x, 2) <= 5)), &
                                                         width_, brief_, sep_, max_elem_len)
            write (unit_, "(*(A))") format_output_string(x_str(size(x, 1), :), width_, brief_, sep_, max_elem_len)

        else
            do i = 1, size(x, 1)
                write (unit_, "(*(A))") format_output_string(x_str(i, :), width_, brief_, sep_, max_elem_len)
            end do
        end if

    end subroutine disp_2_cdp
    subroutine disp_2_iint8(x, header, unit, brief, format, width, sep)

        integer(int8), intent(in) :: x(:, :)
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_, max_elem_len
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str(:, :)
        type(string_type) :: array_info

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        array_info = array_info_maker(size(x, 1), size(x, 2))
        write (unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info))

        allocate (x_str(size(x, 1), size(x, 2)))
        do i = 1, size(x, 1)
            do j = 1, size(x, 2)
                x_str(i, j) = string_type(to_string(x(i, j), format_))
            end do
        end do

        max_elem_len = maxval(len(x_str))

        if (brief_ .and. size(x, 1) > 5) then
            do i = 1, 3
                write (unit_, "(*(A))") format_output_string(x_str(i, :), width_, brief_, sep_, max_elem_len)
            end do

            write (unit_, "(*(A))") format_output_string(coloum(1:merge(size(x, 2), 5, size(x, 2) <= 5)), &
                                                         width_, brief_, sep_, max_elem_len)
            write (unit_, "(*(A))") format_output_string(x_str(size(x, 1), :), width_, brief_, sep_, max_elem_len)

        else
            do i = 1, size(x, 1)
                write (unit_, "(*(A))") format_output_string(x_str(i, :), width_, brief_, sep_, max_elem_len)
            end do
        end if

    end subroutine disp_2_iint8
    subroutine disp_2_iint16(x, header, unit, brief, format, width, sep)

        integer(int16), intent(in) :: x(:, :)
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_, max_elem_len
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str(:, :)
        type(string_type) :: array_info

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        array_info = array_info_maker(size(x, 1), size(x, 2))
        write (unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info))

        allocate (x_str(size(x, 1), size(x, 2)))
        do i = 1, size(x, 1)
            do j = 1, size(x, 2)
                x_str(i, j) = string_type(to_string(x(i, j), format_))
            end do
        end do

        max_elem_len = maxval(len(x_str))

        if (brief_ .and. size(x, 1) > 5) then
            do i = 1, 3
                write (unit_, "(*(A))") format_output_string(x_str(i, :), width_, brief_, sep_, max_elem_len)
            end do

            write (unit_, "(*(A))") format_output_string(coloum(1:merge(size(x, 2), 5, size(x, 2) <= 5)), &
                                                         width_, brief_, sep_, max_elem_len)
            write (unit_, "(*(A))") format_output_string(x_str(size(x, 1), :), width_, brief_, sep_, max_elem_len)

        else
            do i = 1, size(x, 1)
                write (unit_, "(*(A))") format_output_string(x_str(i, :), width_, brief_, sep_, max_elem_len)
            end do
        end if

    end subroutine disp_2_iint16
    subroutine disp_2_iint32(x, header, unit, brief, format, width, sep)

        integer(int32), intent(in) :: x(:, :)
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_, max_elem_len
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str(:, :)
        type(string_type) :: array_info

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        array_info = array_info_maker(size(x, 1), size(x, 2))
        write (unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info))

        allocate (x_str(size(x, 1), size(x, 2)))
        do i = 1, size(x, 1)
            do j = 1, size(x, 2)
                x_str(i, j) = string_type(to_string(x(i, j), format_))
            end do
        end do

        max_elem_len = maxval(len(x_str))

        if (brief_ .and. size(x, 1) > 5) then
            do i = 1, 3
                write (unit_, "(*(A))") format_output_string(x_str(i, :), width_, brief_, sep_, max_elem_len)
            end do

            write (unit_, "(*(A))") format_output_string(coloum(1:merge(size(x, 2), 5, size(x, 2) <= 5)), &
                                                         width_, brief_, sep_, max_elem_len)
            write (unit_, "(*(A))") format_output_string(x_str(size(x, 1), :), width_, brief_, sep_, max_elem_len)

        else
            do i = 1, size(x, 1)
                write (unit_, "(*(A))") format_output_string(x_str(i, :), width_, brief_, sep_, max_elem_len)
            end do
        end if

    end subroutine disp_2_iint32
    subroutine disp_2_iint64(x, header, unit, brief, format, width, sep)

        integer(int64), intent(in) :: x(:, :)
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_, max_elem_len
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str(:, :)
        type(string_type) :: array_info

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        array_info = array_info_maker(size(x, 1), size(x, 2))
        write (unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info))

        allocate (x_str(size(x, 1), size(x, 2)))
        do i = 1, size(x, 1)
            do j = 1, size(x, 2)
                x_str(i, j) = string_type(to_string(x(i, j), format_))
            end do
        end do

        max_elem_len = maxval(len(x_str))

        if (brief_ .and. size(x, 1) > 5) then
            do i = 1, 3
                write (unit_, "(*(A))") format_output_string(x_str(i, :), width_, brief_, sep_, max_elem_len)
            end do

            write (unit_, "(*(A))") format_output_string(coloum(1:merge(size(x, 2), 5, size(x, 2) <= 5)), &
                                                         width_, brief_, sep_, max_elem_len)
            write (unit_, "(*(A))") format_output_string(x_str(size(x, 1), :), width_, brief_, sep_, max_elem_len)

        else
            do i = 1, size(x, 1)
                write (unit_, "(*(A))") format_output_string(x_str(i, :), width_, brief_, sep_, max_elem_len)
            end do
        end if

    end subroutine disp_2_iint64
    subroutine disp_2_llk(x, header, unit, brief, format, width, sep)

        logical(lk), intent(in) :: x(:, :)
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_, max_elem_len
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str(:, :)
        type(string_type) :: array_info

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        array_info = array_info_maker(size(x, 1), size(x, 2))
        write (unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info))

        allocate (x_str(size(x, 1), size(x, 2)))
        do i = 1, size(x, 1)
            do j = 1, size(x, 2)
                x_str(i, j) = string_type(to_string(x(i, j), format_))
            end do
        end do

        max_elem_len = maxval(len(x_str))

        if (brief_ .and. size(x, 1) > 5) then
            do i = 1, 3
                write (unit_, "(*(A))") format_output_string(x_str(i, :), width_, brief_, sep_, max_elem_len)
            end do

            write (unit_, "(*(A))") format_output_string(coloum(1:merge(size(x, 2), 5, size(x, 2) <= 5)), &
                                                         width_, brief_, sep_, max_elem_len)
            write (unit_, "(*(A))") format_output_string(x_str(size(x, 1), :), width_, brief_, sep_, max_elem_len)

        else
            do i = 1, size(x, 1)
                write (unit_, "(*(A))") format_output_string(x_str(i, :), width_, brief_, sep_, max_elem_len)
            end do
        end if

    end subroutine disp_2_llk
    subroutine disp_2_lc_bool(x, header, unit, brief, format, width, sep)

        logical(c_bool), intent(in) :: x(:, :)
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_, max_elem_len
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j
        type(string_type), allocatable :: x_str(:, :)
        type(string_type) :: array_info

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        array_info = array_info_maker(size(x, 1), size(x, 2))
        write (unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info))

        allocate (x_str(size(x, 1), size(x, 2)))
        do i = 1, size(x, 1)
            do j = 1, size(x, 2)
                x_str(i, j) = string_type(to_string(x(i, j), format_))
            end do
        end do

        max_elem_len = maxval(len(x_str))

        if (brief_ .and. size(x, 1) > 5) then
            do i = 1, 3
                write (unit_, "(*(A))") format_output_string(x_str(i, :), width_, brief_, sep_, max_elem_len)
            end do

            write (unit_, "(*(A))") format_output_string(coloum(1:merge(size(x, 2), 5, size(x, 2) <= 5)), &
                                                         width_, brief_, sep_, max_elem_len)
            write (unit_, "(*(A))") format_output_string(x_str(size(x, 1), :), width_, brief_, sep_, max_elem_len)

        else
            do i = 1, size(x, 1)
                write (unit_, "(*(A))") format_output_string(x_str(i, :), width_, brief_, sep_, max_elem_len)
            end do
        end if

    end subroutine disp_2_lc_bool
    subroutine disp_2_tstring_type(x, header, unit, brief, format, width, sep)

        type(string_type), intent(in) :: x(:, :)
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_, max_elem_len
        logical :: brief_
        character(len=:), allocatable :: format_, sep_
        integer :: i, j

        type(string_type) :: array_info

        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        format_ = optval(format, "g0.4")

        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)

        sep_ = optval(sep, "  ")
        coloum = string_type(":")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        array_info = array_info_maker(size(x, 1), size(x, 2))
        write (unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info))

        max_elem_len = maxval(len(x))

        if (brief_ .and. size(x, 1) > 5) then
            do i = 1, 3
                write (unit_, "(*(A))") format_output_string(x(i, :), width_, brief_, sep_, max_elem_len)
            end do

            write (unit_, "(*(A))") format_output_string(coloum(1:merge(size(x, 2), 5, size(x, 2) <= 5)), &
                                                         width_, brief_, sep_, max_elem_len)
            write (unit_, "(*(A))") format_output_string(x(size(x, 1), :), width_, brief_, sep_, max_elem_len)

        else
            do i = 1, size(x, 1)
                write (unit_, "(*(A))") format_output_string(x(i, :), width_, brief_, sep_, max_elem_len)
            end do
        end if

    end subroutine disp_2_tstring_type

    pure function format_output_string(x, width, brief, sep, max_elem_len) result(str)

        type(string_type), intent(in) :: x(:)
        integer, intent(in) :: width
        logical, intent(in) :: brief
        character(len=*), intent(in) :: sep

        integer, intent(in) :: max_elem_len

        character(merge((max(max_elem_len, 2) + len(sep))*min(size(x, 1), 5), width, brief) + 2), allocatable :: str(:)

        character(:), allocatable :: buffer

        character(max(max_elem_len, 2) + len(sep)) :: elem_buffer
        integer :: elem_len, num1, num2, i, j

        if (brief) then

            allocate (str(1))
            buffer = ""

            if (size(x, 1) <= 5) then

                do i = 1, size(x, 1)
                    elem_buffer = char(x(i))//sep
                    buffer = buffer//elem_buffer
                end do

            else

                do i = 1, 3
                    elem_buffer = char(x(i))//sep
                    buffer = buffer//elem_buffer
                end do

                elem_buffer = ".."//sep
                buffer = buffer//elem_buffer

                elem_buffer = char(x(size(x, 1)))//sep
                buffer = buffer//elem_buffer

            end if

            str(1) = buffer

        else

            elem_len = len(elem_buffer)

            num1 = merge(width/elem_len, 1, elem_len <= width)
            num2 = size(x, 1)/num1

            if (num2 > 1 .or. size(x, 1) > 1) then
                allocate (str(merge(num2, num2 + 1, mod(size(x, 1), num1) == 0)))

                do i = 1, size(str) - 1

                    buffer = ""
                    do j = 1, num1
                        elem_buffer = char(x((i - 1)*num1 + j))//sep
                        buffer = buffer//elem_buffer
                    end do

                    if (len(x((i - 1)*num1 + j - 1)) > width - len(sep) - 1) then
                        buffer(width - len(sep) - 1:) = "**"//repeat(" ", len(sep))
                    end if

                    str(i) = buffer

                    str(i) (width + 1:) = "&"//new_line("")

                end do

                buffer = ""
                do j = 1, merge(num1, mod(size(x, 1), num1), mod(size(x, 1), num1) == 0)
                    elem_buffer = char(x((i - 1)*num1 + j))//sep
                    buffer = buffer//elem_buffer
                end do

                if (len(x((i - 1)*num1 + j - 1)) > width - len(sep) - 1) then
                    buffer(width - len(sep) - 1:) = "**"//repeat(" ", len(sep))
                end if

                str(i) = buffer

            else

                allocate (str(1))
                buffer = ""
                do j = 1, size(x, 1)
                    elem_buffer = char(x(j))//sep
                    buffer = buffer//elem_buffer
                end do

                if (len(x(j - 1)) > width - len(sep) - 1) then
                    buffer(width - len(sep) - 1:) = "**"//repeat(" ", len(sep))
                end if

                str(1) = buffer

            end if

        end if

    end function format_output_string

    !> Print array infomation
    pure type(string_type) function array_info_maker(m, n) result(info)
        integer, intent(in) :: m
        integer, intent(in), optional :: n

        if (present(n)) then
            info = string_type('[matrix size: '//to_string(m)//'*'//to_string(n)//']')
        else
            info = string_type('[vector size: '//to_string(m)//']')
        end if

    end function array_info_maker

    !> Display `character(*)` value.
    subroutine disp_char(x, header, unit, brief, format, width, sep)

        character(*), intent(in), optional :: x
        character(len=*), intent(in), optional :: header
        integer, intent(in), optional :: unit
        logical, intent(in), optional :: brief
        character(len=*), intent(in), optional :: format
        integer, intent(in), optional :: width
        character(len=*), intent(in), optional :: sep

        integer :: unit_, width_
        logical :: brief_
        character(len=:), allocatable :: x_, sep_

        !> State default values
        x_ = optval(x, "")
        unit_ = optval(unit, output_unit)
        brief_ = optval(brief, .false.)
        width_ = optval(width, 80)
        width_ = merge(width_, 80, width_ > 80)
        sep_ = optval(sep, "  ")

        if (present(header)) then
            write (unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header))
        end if

        coloum(1) = string_type(x_)
        write (unit_, "(A)") format_output_string(coloum(1:1), width_, brief_, sep_, len(coloum(1)))

    end subroutine disp_char

end module stdlib_io_disp

max_stars_repo_name: zoziha/stdlib-disp-draft

max_issues_repo_name: zoziha/stdlib-disp-draft

max_forks_repo_name: zoziha/stdlib-disp-draft


text:
Sola Bee Farms is run by the Tauzer family. They produce sustainability sustainably harvested 100% pure Bees honey in three varieties.

 Media

  http://woodlandrecord.com/localapiaryintroducessolabeefarmsgiftshoneytothestarsforearthp19791.htm

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


!*************************************************
! module mod_sabicm
!	SABICM(icm, isel)
!
!*************************************************

module mod_sabicm

	implicit none

contains
!=========
subroutine SABICM(icm, isel)

	use prm_inv
	use prm_var
	use mod_subabic

	implicit none

	integer, intent(in) :: icm
	integer, intent(inout) :: isel

	real(8) :: detc, detf, tn, abic(20), alphalog(20), step, abicmin, offset
	integer :: i, j, imin

!	open(88,file="alpha.opt")
!	read (88,*) ch
	open(89,file="alpha.dat")
	write(89,*) "log(alpha) alpha abic rsq2 sigma" ! detc jct detf jmt jdata"

	step = 0.5d0
	offset = - 4.d0
	abicmin = 1000.d0
	imin = 0

	do j = 1, 2

		if(setalpha < 90.d0) then
			imin = 1
			alphalog(imin) = setalpha
			exit
		end if

		do i = 1, 20
!			read(88,*) isel, alphalog
			alphalog(i) = dble(i-10)*step + offset
			alpha = 10.d0 ** alphalog(i)

!			print *, " ENTER ALPHA "
!			read *, alpha

			CALL RESET(alpha, detc, jdata, jct, jmt)
			CALL FREEMIN(detf, rsq2, jdata, jct, jmt)

			if(icm /= 0) CALL INEQMIN(detf)

			tn = dble(jdata + jct - jmt)

			abic(i) = tn + tn * dlog(2.d0*pi*rsq2/tn) - 2.d0 * (dble(jct) * dlog(alpha) + detc - detf)
			sigma = dsqrt(rsq2/tn)

!			print 600, alphalog(i), abic(i), rsq2, sigma, detc, jct, detf, jmt, jdata
			write(89,'(F6.2,4X,F10.5,4X,F10.3,4X,F10.5,4X,F10.5)') alphalog(i), alpha, abic(i), rsq2, sigma
!			print *, ' ENTER ISEL '
!			print *, ' 0/CHANGE ALPHA :  1/COMPUTE RESULT :  2/STOP '
!			read *, isel

!			if(isel == 0) cycle
!			if(isel == 1) exit
!			if(isel /= 0 .and. isel /= 1) stop 'ERROR (in alpha.opt)'

			if(abic(i) < abicmin) then
				abicmin = abic(i)
				imin = i
			end if

		end do

		write(89,*)

		if(imin == 1 .or. imin == 20) stop 'OUT OF ALPHA REGION: LOG ALPHA = (-9,+1)'
		if(j == 2) exit

		step = 0.1d0
		offset = alphalog(imin)

	end do

	alphalog(1) = alphalog(imin)
	alpha = 10.d0 ** alphalog(1)

	CALL RESET(alpha, detc, jdata, jct, jmt)
	CALL FREEMIN(detf, rsq2, jdata, jct, jmt)

	if(icm /= 0) CALL INEQMIN(detf)

	tn = dble(jdata + jct - jmt)

	abic(1) = tn + tn * dlog(2.d0*pi*rsq2/tn) - 2.d0 * (dble(jct) * dlog(alpha) + detc - detf)
	sigma = dsqrt(rsq2/tn)

	isel = 1

	print 600, alphalog(1), abic(1), rsq2, sigma, detc, jct, detf, jmt, jdata
		  600 FORMAT(/' ','LOG_ALPHA=',F6.3,' ABIC=',F10.3,' RSQ2=',F10.3, &
		     ' SIGMA=',F10.3//' ','DETC= ',E10.4,' JCT= ',I4/' DETF= ',E10.4, &
		     ' JMT= ',I4,12X,' JDATA= ',I4)
	write(89,'(F6.2,4X,F10.5,4X,F10.3,4X,F10.5,4X,F10.5)') alphalog(1), alpha, abic(1), rsq2, sigma

!	close(88)
	close(89)

return
end subroutine SABICM
!=========

end module mod_sabicm


! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
! Main Program File
!
! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
!       (http://www.cs.vt.edu/~asandu/Software/KPP)
! KPP is distributed under GPL, the general public licence
!       (http://www.gnu.org/copyleft/gpl.html)
! (C) 1995-1997, V. Damian & A. Sandu, CGRER, Univ. Iowa
! (C) 1997-2005, A. Sandu, Michigan Tech, Virginia Tech
!     With important contributions from:
!        M. Damian, Villanova University, USA
!        R. Sander, Max-Planck Institute for Chemistry, Mainz, Germany
!
! File                 : kpp_achem_gas_Main.f90
! Time                 : Thu Jun 11 11:33:46 2015
! Working directory    : /gpfsm/dnb32/adarmeno/models/geos-5/heracles-UNSTABLE-DEV_MICROPHYSICS/src/GEOSgcs_GridComp/GEOSgcm_GridComp/GEOSagcm_GridComp/GEOSphV
! Equation file        : kpp_achem_gas.kpp
! Output root filename : kpp_achem_gas
!
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
! MAIN - Main program - driver routine
!   Arguments :
!
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

PROGRAM kpp_achem_gas_Driver

  USE kpp_achem_gas_Model
  USE kpp_achem_gas_Initialize, ONLY: Initialize

      REAL(kind=dp) :: T, DVAL(NSPEC)
      REAL(kind=dp) :: RSTATE(20)
      INTEGER :: i

!~~~> Initialization

      STEPMIN = 0.0d0
      STEPMAX = 0.0d0

      DO i=1,NVAR
        RTOL(i) = 1.0d-4
        ATOL(i) = 1.0d-3
      END DO

      CALL Initialize()
      CALL InitSaveData()

!~~~> Time loop
      T = TSTART
kron: DO WHILE (T < TEND)

        TIME = T
        CALL GetMass( C, DVAL )
        WRITE(6,991) (T-TSTART)/(TEND-TSTART)*100, T,       &
                   ( TRIM(SPC_NAMES(MONITOR(i))),           &
                     C(MONITOR(i))/CFACTOR, i=1,NMONITOR )
        CALL SaveData()
        CALL Update_SUN()
        CALL Update_RCONST()

        CALL INTEGRATE( TIN = T, TOUT = T+DT, RSTATUS_U = RSTATE, &
        ICNTRL_U = (/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 /) )
        T = RSTATE(1)

      END DO kron
!~~~> End Time loop

      CALL GetMass( C, DVAL )
      WRITE(6,991) (T-TSTART)/(TEND-TSTART)*100, T,     &
               ( TRIM(SPC_NAMES(MONITOR(i))),           &
                 C(MONITOR(i))/CFACTOR, i=1,NMONITOR )
      TIME = T
      CALL SaveData()
      CALL CloseSaveData()

991   FORMAT(F6.1,'%. T=',E9.3,2X,200(A,'=',E11.4,'; '))

END PROGRAM kpp_achem_gas_Driver

! End of MAIN function
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


text:
      LOGICAL FUNCTION RLZMS (MSSET, MSEXP)

C  RLZMS sets a requested marker size scale factor in the polymarker bundle
C  table, and checks to see that it is realized approximately equal to the
C  expected value.

C  Input parameters:
C    MSSET : Requested value for marker size scale factor
C    MSEXP : Expected value for realized marker size scale factor

      COMMON /GLOBNU/ CTLHND, ERRSIG, ERRFIL, IERRCT, UNERR,
     1        TESTCT, IFLERR, PASSSW, ERRSW, MAXLIN,
     2        CONID, MEMUN, WKID, WTYPE, GLBLUN, INDLUN,
     3        DUMINT, DUMRL
      INTEGER         CTLHND, ERRSIG, ERRFIL, IERRCT, UNERR,
     1        TESTCT, IFLERR, PASSSW, ERRSW, MAXLIN,
     2        CONID, MEMUN, WKID, WTYPE, GLBLUN, INDLUN,
     3        DUMINT(20), ERRIND
      REAL    DUMRL(20)

      INTEGER    PSET,     PREALI
      PARAMETER (PSET = 0, PREALI = 1)

      INTEGER  IDUM1,IDUM2

      REAL     MSSET,MSEXP,RMS

      LOGICAL  APPEQ

      CALL PSPMR (WKID, 4, 1, MSSET, 1)
      CALL PQPMR (WKID, 4, PREALI, ERRIND, IDUM1, RMS, IDUM2)
      CALL CHKINQ ('pqpmr', ERRIND)
      RLZMS = APPEQ (RMS, MSEXP, 0.0, 0.02)

      END


text:
Quad Phone 3 on the Campus Payphones node

Phone Number: (530) 7569995

Location: Next to the the Memorial Union: Flagpole flagpole by the quad walkway.

Description: There may have been two phones here in past but one disappeared.

Charge: 50 cents for locals calls.


text:
program test_free_energy
use types, only: dp
use ofdft_fe, only: free_energy2
use constants, only: Ha2eV, pi
use utils, only: loadtxt, assert
use splines, only: spline3pars, iixmin, poly3
use interp3d, only: trilinear
use feutils, only: quad_gauss
use converged_energies, only: one_gaussian
implicit none
real(dp) :: Eh, Een, Ts, Exc, Etot
integer :: p, DOF, Nq
real(dp) :: Z
real(dp) :: Rcut, L, T_eV, T_au

Z = 1
Rcut = 0.3_dp
p = 4
L = 2
T_eV = 0.0862_dp
T_au = T_ev / Ha2eV
Nq = 20
call free_energy2(1._dp, L, 8, 8, 8, p, T_au, nen, ne, &
        Nq, quad_gauss, &
        Eh, Een, Ts, Exc, DOF)
Etot = Ts + Een + Eh + Exc
print *, "p =", p
print *, "DOF =", DOF
print *, "Rcut =", Rcut
print *, "T_au =", T_au
print *, "Summary of energies [a.u.]:"
print "('    Ts   = ', f14.8)", Ts
print "('    Een  = ', f14.8)", Een
print "('    Eee  = ', f14.8)", Eh
print "('    Exc  = ', f14.8)", Exc
print *, "   ---------------------"
print "('    Etot = ', f14.8, ' a.u. = ', f14.8, ' eV')", Etot, Etot*Ha2eV

! The reference answers are converged to at least 1e-5:
print *, abs(Ts  - one_gaussian(1))
call assert(abs(Ts  - one_gaussian(1)) < 1e-4)
print *, abs(Een - (- 3.80769))
call assert(abs(Een - (- 3.80769)) < 1e-4)
print *, abs(Eh  - one_gaussian(3))
call assert(abs(Eh  - one_gaussian(3)) < 1e-4)
print *, abs(Exc  - one_gaussian(4))
call assert(abs(Exc  - one_gaussian(4)) < 1e-4)

contains

real(dp) function nen(x, y, z_) result(n)
real(dp), intent(in) :: x, y, z_
real(dp), parameter :: alpha = 12
real(dp) :: r
r = sqrt((x-L/2)**2+(y-L/2)**2+(z_-L/2)**2)
! This density:
n = -Z*alpha**3/pi**(3._dp/2)*exp(-alpha**2*R**2)
! Corresponds to the potential:
!V = -Z*erf(alpha*R)/R
end function

real(dp) function ne(x, y, z) result(n)
real(dp), intent(in) :: x, y, z
real(dp), parameter :: alpha = 5, Z_ = 1
real(dp) :: r
r = sqrt((x-L/2)**2+(y-L/2)**2+(z-L/2)**2)
n = Z_*alpha**3/pi**(3._dp/2)*exp(-alpha**2*R**2)
end function

end program

max_stars_repo_name: certik/hfsolver

max_issues_repo_name: certik/hfsolver

max_forks_repo_name: certik/hfsolver


module assignment_test
    use fruit
    use global_defs
    use assignment_problem_mod
    implicit none

contains

    subroutine test_assignment_square
        integer, parameter :: n = 4
        real(dp) :: test_mat(n, n)
        integer, allocatable :: res_row(:)
        integer, allocatable :: res_col(:)

        test_mat(1, :) = [1, 0, 0, 0]
        test_mat(2, :) = [0, 0, 0, 1]
        test_mat(3, :) = [0, 1, 0, 0]
        test_mat(4, :) = [0, 0, 1, 0]
        call assignment_problem(-test_mat, res_row, res_col)
        call assert_equals([1, 2, 3, 4], res_row, n, 'Assigned rows vector.')
        call assert_equals([1, 4, 2, 3], res_col, n, 'Assigned columns vector.')

        test_mat(1, :) = [1, 2, 3, 4]
        test_mat(2, :) = [2, 4, 6, 8]
        test_mat(3, :) = [3, 6, 9, 12]
        test_mat(4, :) = [4, 8, 12, 16]
        call assignment_problem(test_mat, res_row, res_col)
        call assert_equals([1, 2, 3, 4], res_row, n, 'Assigned rows vector.')
        call assert_equals([4, 3, 2, 1], res_col, n, 'Assigned columns vector.')
    end subroutine test_assignment_square

    subroutine test_assignment_rectangular_more_rows
        integer, parameter :: m = 5
        integer, parameter :: n = 3
        real(dp) :: test_mat(m, n)
        integer, allocatable :: res_row(:)
        integer, allocatable :: res_col(:)

        test_mat(1, :) = [1, 0, 0]
        test_mat(2, :) = [0, 0, 0]
        test_mat(3, :) = [0, 0, 1]
        test_mat(4, :) = [0, 1, 0]
        test_mat(5, :) = [0, 0, 0]
        call assignment_problem(-test_mat, res_row, res_col)
        call assert_equals([1, 3, 4], res_row, n, 'Assigned rows vector.')
        call assert_equals([1, 3, 2], res_col, n, 'Assigned columns vector.')
    end subroutine test_assignment_rectangular_more_rows

    subroutine test_assignment_rectangular_more_cols
        integer, parameter :: m = 3
        integer, parameter :: n = 5
        real(dp) :: test_mat(m, n)
        integer, allocatable :: res_row(:)
        integer, allocatable :: res_col(:)

        test_mat(1, :) = [1, 0, 0, 0, 0]
        test_mat(2, :) = [0, 0, 0, 1, 0]
        test_mat(3, :) = [0, 0, 1, 0, 0]
        call assignment_problem(-test_mat, res_row, res_col)
        call assert_equals([1, 2, 3], res_row, m, 'Assigned rows vector.')
        call assert_equals([1, 4, 3], res_col, m, 'Assigned columns vector.')
    end subroutine test_assignment_rectangular_more_cols

end module assignment_test


text:
 Samantha Grant
Name: Samantha Grant

Personality: Samantha Grant seems to know a lot about restaurants in Davis.  She has made edits on the pages for Kims Mart, Kabul Afghan Cuisine and Thai Nakorn.  If you are or know Samantha Grant, you should Wiki Style Guide edit this page.

Yes I enjoy reviewing restaurants.  If you can suggest a good place in Davis or Sacramento, let me know.  I appreciate good food, be it at some place fancy or a hole in the wall. Here is my website, completely unrelated to food: http://www.geocities.com/samgrant01/index.html

Heres a shout out to all my friends at Davis Aquatic Masters and a shot of me at the 2005 Lake Berryessa race.  http://www.damfast.org