text:
      SUBROUTINE BDAT02
C
C     THIS SUBROUTINE PROCESSES CONCT BULK DATA AND WRITES CONNECTION
C     ENTRIES IN TERMS OF CODED GRID POINT ID NUMBERS ON SCR1
C
      EXTERNAL        RSHIFT,ANDF
      LOGICAL         TDAT,PRINT
      INTEGER         SCR1,OUTT,BUF1,BUF2,CONCT(2),FLAG,GEOM4,ID(2),
     1                COMP,NAMS(4),IO(9),AAA(2),CONSET,ANDF,RSHIFT,COMBO
      DIMENSION       IBITS(32),JBITS(32),NAME(14),IHD(16)
      CHARACTER       UFM*23
      COMMON /XMSSG / UFM
      COMMON /CMB001/ SCR1,SCR2,SCBDAT,SCSFIL,SCCONN,SCMCON,SCTOC,
     1                GEOM4,CASECC
      COMMON /ZZZZZZ/ Z(1)
      COMMON /CMB002/ BUF1,BUF2,BUF3,BUF4,BUF5,SCORE,LCORE,INPT,OUTT
      COMMON /CMB003/ COMBO(7,5),CONSET,IAUTO,TOLER,NPSUB,CONECT,TRAN,
     1                MCON,RESTCT(7,7),ISORT,ORIGIN(7,3),IPRINT
      COMMON /CMB004/ TDAT(6)
      COMMON /OUTPUT/ ITITL(96),IHEAD(96)
      COMMON /CMBFND/ INAM(2),IERR
      COMMON /BLANK / STEP,IDRY
      DATA    AAA   / 4HBDAT,4H02       / , CONCT  / 210,2  /
      DATA    IHD   / 4H  SU , 4HMMAR , 4HY OF , 4H CON , 4HNECT ,
     1                4HION  , 4HENTR , 4HIES  , 4HSPEC , 4HIFIE ,
     2                4HD BY , 4H CON , 4HCT   , 4HBULK , 4H DAT ,
     3                4HA    /
      DATA    IBLNK / 4H     /
C
      DO 10 I = 1,96
      IHEAD(I) = IBLNK
   10 CONTINUE
      J = 1
      DO 20 I = 73,88
      IHEAD(I) = IHD(J)
   20 J = J + 1
      PRINT = .FALSE.
      IF (ANDF(RSHIFT(IPRINT,3),1) .EQ. 1) PRINT = .TRUE.
      NP2 = 2*NPSUB
      DO 30 I = 1,NP2,2
      J = I/2 + 1
      NAME(I  ) = COMBO(J,1)
      NAME(I+1) = COMBO(J,2)
   30 CONTINUE
      IFILE = SCR1
      CALL OPEN (*220,SCR1,Z(BUF2),3)
      CALL LOCATE (*180,Z(BUF1),CONCT,FLAG)
      IFILE = GEOM4
   40 CALL READ (*200,*170,GEOM4,ID,1,0,N)
      IF (ID(1) .EQ. CONSET) GO TO 60
      CALL READ (*200,*210,GEOM4,ID,-5,0,N)
   50 CALL READ (*200,*210,GEOM4,ID,2,0,N)
      IF (ID(1)+ID(2) .NE. -2) GO TO 50
      GO TO 40
   60 CALL READ (*200,*210,GEOM4,COMP,1,0,N)
      IF (.NOT.PRINT) GO TO 80
      CALL PAGE
      CALL PAGE2 (6)
      WRITE  (OUTT,70) (NAME(KDH),KDH=1,NP2)
   70 FORMAT (/24X,74HNOTE  GRID POINT ID NUMBERS HAVE BEEN CODED TO THE
     1 COMPONENT SUBSTRUCTURE ,/30X,75HWITHIN A GIVEN PSEUDOSTRUCTURE BY
     2 - 1000000*COMPONENT NO. + ACTUAL GRID ID., //15X,22HCONNECTED   C
     3ONNECTION,23X,33HGRID POINT ID FOR PSEUDOSTRUCTURE/18X,3HDOF,9X,
     44HCODE,3X,7(3X,2A4)/)
   80 CONTINUE
      TDAT(2) = .TRUE.
      CALL ENCODE (COMP)
      CALL READ (*200,*210,GEOM4,NAMS,4,0,N)
      CALL FINDER (NAMS(1),IS1,IC1)
      IF (IERR .NE. 1) GO TO 90
      WRITE (OUTT,100) UFM,NAMS(1),NAMS(2)
      IDRY = -2
   90 CONTINUE
      CALL FINDER (NAMS(3),IS2,IC2)
      IF (IERR .NE. 1) GO TO 110
      WRITE (OUTT,100) UFM,NAMS(3),NAMS(4)
      IDRY = -2
  100 FORMAT (A23,' 6523, THE BASIC SUBSTRUCTURE ',2A4, /30X,
     1       'REFERED TO BY A CONCT  BULK DATA CARD CAN NOT BE FOUND ',
     2       'IN THE PROBLEM TABLE OF CONTENTS.')
  110 CALL READ (*200,*210,GEOM4,ID,2,0,N)
C
      IF (ID(1)+ID(2) .EQ. -2) GO TO 40
      IF (IS1 .NE. IS2) GO TO 130
      KK = 2*IS1 - 1
      WRITE  (OUTT,120) UFM,ID(1),ID(2),NAME(KK),NAME(KK+1)
  120 FORMAT (A23,' 6536, MANUAL CONNECTION DATA IS ATTEMPTING TO ',
     1       'CONNECT', /31X,'GRID POINTS',I9,5X,4HAND ,I8, /31X,
     2       'WHICH ARE BOTH CONTAINED IN PSEUDOSTRUCTURE ',2A4)
      IDRY = -2
  130 CONTINUE
      DO 140 I = 1,9
  140 IO(I) = 0
      IO(1) = COMP
      IO(2) = 2**(IS1-1) + 2**(IS2-1)
      IO(2+IS1) = IC1*1000000 + ID(1)
      IO(2+IS2) = IC2*1000000 + ID(2)
      NWD = 2 + NPSUB
      CALL WRITE (SCR1,IO,NWD,1)
      IF (.NOT.PRINT .OR. IDRY.EQ.-2) GO TO 160
      CALL BITPAT (IO(1),IBITS)
      CALL BITPAT (IO(2),JBITS)
      CALL PAGE2 (1)
      WRITE (OUTT,150) (IBITS(KDH),KDH=1,2),(JBITS(KDH),KDH=1,2),
     1                 (IO(KDH+2),KDH=1,NPSUB)
  150 FORMAT (16X,A4,A2,6X,A4,A3,2X,7(3X,I8))
  160 CONTINUE
      GO TO 110
  170 CONTINUE
  180 CALL CLOSE (SCR1,1)
      RETURN
C
  200 IMSG = -2
      GO TO 230
  210 IMSG = -3
      GO TO 230
  220 IMSG = -1
  230 CALL MESAGE (IMSG,IFILE,AAA)
      RETURN
      END

ext: f


MODULE m_flowa

    USE m_globals
    IMPLICIT NONE

    ! filenames (hardcoded, for now)
    CHARACTER ( LEN = 255 ), PARAMETER :: filename_xyz = 'flowa.xyz'
    CHARACTER ( LEN = 255 ), PARAMETER :: filename_dat = 'flowa.dat'
    CHARACTER ( LEN = 255 ), PARAMETER :: filename_sorted = 'flowa_sorted.xyz'
    CHARACTER ( LEN = 255 ), PARAMETER :: filename_filtered = 'flowa_filtered.xyz'

    INTEGER, PARAMETER :: file_xyz_unit = 10
    INTEGER, PARAMETER :: file_dat_unit = 11
    INTEGER, PARAMETER :: file_sorted_unit = 12
    INTEGER, PARAMETER :: file_filtered_unit = 13

    INTEGER, PARAMETER :: miniter = 100
    INTEGER, PARAMETER :: maxiter = 4000
    INTEGER, PARAMETER :: batchsize = 10000

    TYPE orbite_t
        REAL (KIND=4), DIMENSION(:), ALLOCATABLE :: pts_x
        REAL (KIND=4), DIMENSION(:), ALLOCATABLE :: pts_y
        REAL (KIND=4), DIMENSION(:), ALLOCATABLE :: pts_z
        INTEGER (KIND=2) :: col_r
        INTEGER (KIND=2) :: col_g
        INTEGER (KIND=2) :: col_b
        INTEGER :: iter
        REAL :: r
    END TYPE orbite_t

    TYPE(orbite_t), DIMENSION(:) :: orbite(batchsize)

CONTAINS

    SUBROUTINE init_flowa
        IMPLICIT NONE

        pts_found = 0

        OPEN( unit = file_xyz_unit, file = filename_xyz, status = 'replace', &
            form = 'formatted',   access = 'sequential')
        OPEN( unit = file_dat_unit, file = filename_dat, status = 'replace', &
            form = 'unformatted', access = 'stream')
    END SUBROUTINE init_flowa

SUBROUTINE start_flowa()
    USE m_globals
    IMPLICIT NONE

    INTEGER :: i

    DO i=1, batchsize
        ALLOCATE(orbite(i)%pts_x(maxiter - miniter))
        ALLOCATE(orbite(i)%pts_y(maxiter - miniter))
        ALLOCATE(orbite(i)%pts_z(maxiter - miniter))
    END DO
    flowa_allocated = .TRUE.
END SUBROUTINE

SUBROUTINE stop_flowa()
    IMPLICIT NONE
    INTEGER :: i

    DO i=1, batchsize
        DEALLOCATE(orbite(i)%pts_x)
        DEALLOCATE(orbite(i)%pts_y)
        DEALLOCATE(orbite(i)%pts_z)
    END DO
    flowa_allocated = .FALSE.
END SUBROUTINE

SUBROUTINE update_flowa()
        IMPLICIT NONE

        REAL :: x=0 ,y=0 ,z=0 ,nx=0 ,ny=0 ,nz=0, r2p=0 ,th=0 ,ph=0 , p=2
        REAL :: xmin = -1.0, xmax = 2.0, ymin = -1.3, ymax =1.3
        INTEGER (KIND=8) :: i = 1, j=1

        !$OMP PARALLEL DEFAULT(PRIVATE) SHARED(orbite)
        x=0; y=0; z=0
        nx=0; ny=0; nz=0
        r2p=0; th=0; ph=0; p=2
        xmin = -1.0; xmax = 2.0
        ymin = -1.3; ymax =1.3

        !$OMP DO
        DO i=1, batchsize

            CALL RANDOM_NUMBER(x)
            CALL RANDOM_NUMBER(y)
            CALL RANDOM_NUMBER(z)
            !orbite(i)%pts_x = 0
            !orbite(i)%pts_y = 0
            !orbite(i)%pts_z = 0
            orbite(i)%iter = 0
            orbite(i)%r = 0

            x = (x * 2.6) - 1.3
            y = (y * 2.6) - 1.3
            z = (z * 2.6) - 1.3
            nx = x
            ny = y
            nz = z
            orbite(i)%r=sqrt(x*x+y*y+z*z)
            th=atan(y/x)*p
            ph=asin(z/orbite(i)%r)*p

            DO WHILE((orbite(i)%iter < MAXITER) .AND. (orbite(i)%r < 2.0) &
                .AND. (nx /= 0.0) .AND. (orbite(i)%r /= 0.0) .AND. (nx /= -0.0) &
                    .AND. (orbite(i)%r /= -0.0))

               r2p = (orbite(i)%r*orbite(i)%r)
               th=atan(ny/nx)*p
               ph=asin(nz/orbite(i)%r)*p
               nx=r2p*cos(ph)*cos(th)+x
               ny=r2p*cos(ph)*sin(th)+y
               nz=r2p*sin(ph)+z
               orbite(i)%r=sqrt(nx*nx+ny*ny+nz*nz)

               IF(orbite(i)%iter > miniter) THEN
                    orbite(i)%pts_x(orbite(i)%iter - miniter) = nx
                    orbite(i)%pts_y(orbite(i)%iter - miniter) = ny
                    orbite(i)%pts_z(orbite(i)%iter - miniter) = nz
               END IF

               orbite(i)%iter = orbite(i)%iter +1

            END DO
        END DO
        !$OMP END DO
        !$OMP END PARALLEL

        DO i=1, batchsize

            IF(((orbite(i)%iter) > miniter) .AND. (orbite(i)%iter) < maxiter) THEN

                DO j=1, (orbite(i)%iter) - miniter , 1

                    !only write if r < 2
                    IF(sqrt(orbite(i)%pts_x(j) * orbite(i)%pts_x(j) + &
                        orbite(i)%pts_y(j) * orbite(i)%pts_y(j) + &
                        orbite(i)%pts_z(j) * orbite(i)%pts_z(j)) < 2.0) THEN
                        pts_found = pts_found + 1
                        IF(j == 1) THEN
                            orbite(i)%col_r = max(6,min(254,INT(abs(orbite(i)%pts_x(j) * 255))))
                            orbite(i)%col_g = max(6,min(254,INT(abs(orbite(i)%pts_y(j) * 255))))
                            orbite(i)%col_b = max(6,min(254,INT(abs(orbite(i)%pts_z(j) * 255))))
                        END IF

                        !!$OMP CRITICAL
                        WRITE( file_xyz_unit, '(f8.4,f8.4,f8.4,i4,i4,i4)' ) &
                            orbite(i)%pts_x(j), orbite(i)%pts_y(j), orbite(i)%pts_z(j), &
                                orbite(i)%col_r, orbite(i)%col_g, orbite(i)%col_b
                        WRITE( file_dat_unit ) orbite(i)%pts_x(j), orbite(i)%pts_y(j), orbite(i)%pts_z(j), &
                            orbite(i)%col_r, orbite(i)%col_g, orbite(i)%col_b
                        !!$OMP END CRITICAL
                    END IF
                END DO
            END IF
        END DO

END SUBROUTINE

SUBROUTINE sort_flowa()
    USE appgraphics
    USE m_sort

    IMPLICIT NONE

    INTEGER :: i
    INTEGER :: reason = 0
    INTEGER :: lines = 0
    LOGICAL :: xyzo

    TYPE(data_t), ALLOCATABLE :: dat(:)

    ! close and reopen xyz
    INQUIRE(file_xyz_unit,opened=xyzo)          ! check if opened
    IF(xyzo) close ( unit = file_xyz_unit )     ! close if already opened
    open( unit = file_xyz_unit, file = filename_xyz, status = 'old', &
        form = 'formatted',   access = 'sequential')

    ! count lines
    lines = 0
    reason = 0
    DO WHILE(reason == 0)
        read(file_xyz_unit, *, iostat=reason)
        IF(reason == 0) lines = lines + 1
    END DO

    ! allocate dat with line numbers
    ALLOCATE(dat(lines))
    reason = 0
    lines = 0

    ! close and reopen xyz
    close(file_xyz_unit)
    open ( unit = file_xyz_unit, file = filename_xyz, status = 'old', &
        form = 'formatted',   access = 'sequential')

    ! read xyz, dump to memory (dat), close
    DO WHILE(reason == 0)
        lines = lines + 1
        read( file_xyz_unit, '(f8.4,f8.4,f8.4,i4,i4,i4)', iostat=reason) &
            dat(lines)%x,dat(lines)%y,dat(lines)%z,dat(lines)%r,dat(lines)%g,dat(lines)%b
        !if(reason == 0) write( file_sorted_unit, '(f8.4,f8.4,f8.4,i4,i4,i4)' ) x,y,z,r,g,b
    END do
    close(file_xyz_unit)

    ! call sort
    call quicksort_x(dat, 1, lines-1)

    ! open sorted, write, close
    open ( unit = file_sorted_unit, file = filename_sorted, status = 'replace', &
        form = 'formatted',   access = 'sequential')
    DO i=1, lines
        write( file_sorted_unit, '(f8.4,f8.4,f8.4,i4,i4,i4)' ) &
            dat(i)%x, dat(i)%y, dat(i)%z, dat(i)%r, dat(i)%g, dat(i)%b
    END do
    close(file_sorted_unit)

    !cleanup
    DEALLOCATE(dat)

END SUBROUTINE

SUBROUTINE filter_flowa()
    IMPLICIT NONE

    INTEGER :: i
    INTEGER :: reason = 0
    INTEGER :: lines = 0
    LOGICAL :: sortedo

    TYPE(data_t), ALLOCATABLE :: dat(:)

    ! close and reopen xyz
    INQUIRE(file_sorted_unit,opened=sortedo)          ! check if opened
    IF(sortedo) close ( unit = file_sorted_unit )     ! close if already opened
    open( unit = file_sorted_unit, file = filename_sorted, status = 'old', &
        form = 'formatted',   access = 'sequential')

    ! count lines
    lines = 0
    reason = 0
    DO WHILE(reason == 0)
        read(file_sorted_unit, *, iostat=reason)
        IF(reason == 0) lines = lines + 1
    END DO

    ! allocate dat with line numbers
    ALLOCATE(dat(lines))
    reason = 0
    lines = 0

    DO WHILE(reason == 0)
        lines = lines + 1
        read( file_sorted_unit, '(f8.4,f8.4,f8.4,i4,i4,i4)', iostat=reason) &
            dat(lines)%x,dat(lines)%y,dat(lines)%z,dat(lines)%r,dat(lines)%g,dat(lines)%b
        !if(reason == 0) write( file_sorted_unit, '(f8.4,f8.4,f8.4,i4,i4,i4)' ) x,y,z,r,g,b
    END do
    close(file_sorted_unit)

    !do the filtering

    !write to sorted file

    !cleanup
    DEALLOCATE(dat)

END SUBROUTINE

SUBROUTINE close_flowa()
    IMPLICIT NONE
    LOGICAL :: xyzo, dato, sorto

    inquire(file_dat_unit,opened=dato)
    IF(dato) close ( unit = file_dat_unit )

    inquire(file_xyz_unit,opened=xyzo)
    IF(xyzo) close ( unit = file_xyz_unit )

    inquire(file_sorted_unit,opened=sorto)
    IF(sorto) close ( unit = file_sorted_unit )

END SUBROUTINE

END MODULE m_flowa


text:
      PROGRAM xfgauss
C     driver for routine fgauss
      INTEGER NA,NLIN,NPT
      PARAMETER(NPT=3,NLIN=2,NA=3*NLIN)
      INTEGER i,j
      REAL e1,e2,f,x,y,a(NA),dyda(NA),df(NA)
      DATA a/3.0,0.2,0.5,1.0,0.7,0.3/
      write(*,'(/1x,t6,a,t14,a,t19,a,t27,a,t35,a,t43,a,t51,a,t59,a)')
     *     'X','Y','DYDA1','DYDA2','DYDA3','DYDA4','DYDA5','DYDA6'
      do 11 i=1,NPT
        x=0.3*i
        call fgauss(x,a,y,dyda,NA)
        e1=exp(-((x-a(2))/a(3))**2)
        e2=exp(-((x-a(5))/a(6))**2)
        f=a(1)*e1+a(4)*e2
        df(1)=e1
        df(4)=e2
        df(2)=a(1)*e1*2.0*(x-a(2))/(a(3)**2)
        df(5)=a(4)*e2*2.0*(x-a(5))/(a(6)**2)
        df(3)=a(1)*e1*2.0*((x-a(2))**2)/(a(3)**3)
        df(6)=a(4)*e2*2.0*((x-a(5))**2)/(a(6)**3)
        write(*,'(1x,a/,8f8.4)') 'from FGAUSS',x,y,(dyda(j),j=1,6)
        write(*,'(1x,a/,8f8.4/)') 'independent calc.',x,f,(df(j),j=1,6)
11    continue
      END

ext: for

max_stars_repo_path: NR-Functions/Numerical Recipes- Example & Functions/Examples/xfgauss.for


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 SHWINT (ITRANT, DIM3)
C=======================================================================

      CHARACTER*20 RSTR(9)
      CHARACTER*20 TYPE

      CALL NUMSTR (1, 4, DIM3, RSTR(1), LR)

      IF      (ITRANT .EQ.  0) THEN
         TYPE = 'Transform'
      ELSE IF (ITRANT .EQ.  1) THEN
         TYPE = 'Translate'
      ELSE IF (ITRANT .EQ.  2) THEN
         TYPE = 'Rotate'
      ELSE IF (ITRANT .EQ.  4) THEN
         TYPE = 'Warp'
      ELSE IF (ITRANT .EQ.  8) THEN
         TYPE = 'Twist'
      ELSE IF (ITRANT .EQ. 16) THEN
         TYPE = 'Project'
      ELSE IF (ITRANT .EQ. 32) THEN
         TYPE = 'ExpRotate'
      ELSE IF (ITRANT .EQ. 64) THEN
         TYPE = 'Spline'
      ELSE
         CALL PRTERR ('PROGRAM', 'Unknown transformation option')
         RETURN
      END IF

      LT = LENSTR(TYPE)

      WRITE (*, 20) TYPE(:LT), ' mesh, thickness = ', RSTR(1)(:LR)
 20   FORMAT (1X, 10A)
      RETURN
      END

max_stars_repo_name: jschueller/seacas

max_issues_repo_name: jschueller/seacas

max_forks_repo_name: jschueller/seacas


!
!                Parallel Sparse BLAS  version 3.5
!      (C) Copyright 2006-2018
!        Salvatore Filippone
!        Alfredo Buttari
!
!    Redistribution and use in source and binary forms, with or without
!    modification, are permitted provided that the following conditions
!    are met:
!      1. Redistributions of source code must retain the above copyright
!         notice, this list of conditions and the following disclaimer.
!      2. Redistributions in binary form must reproduce the above copyright
!         notice, this list of conditions, and the following disclaimer in the
!         documentation and/or other materials provided with the distribution.
!      3. The name of the PSBLAS group or the names of its contributors may
!         not be used to endorse or promote products derived from this
!         software without specific written permission.
!
!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!    POSSIBILITY OF SUCH DAMAGE.
!
!
!
! package: psb_z_csc_mat_mod
!
! This module contains the definition of the psb_z_csc_sparse_mat type
! which implements an actual storage format (the CSC in this case) for
! a sparse matrix as well as the related methods (those who are
! specific to the type and could not be defined higher in the
! hierarchy). We are at the bottom level of the inheritance chain.
!
! Please refere to psb_z_base_mat_mod for a detailed description
! of the various methods, and to psb_z_csc_impl for implementation details.
!
module psb_z_csc_mat_mod

  use psb_z_base_mat_mod

  !> \namespace  psb_base_mod  \class  psb_z_csc_sparse_mat
  !! \extends psb_z_base_mat_mod::psb_z_base_sparse_mat
  !!
  !! psb_z_csc_sparse_mat type and the related methods.
  !!
  type, extends(psb_z_base_sparse_mat) :: psb_z_csc_sparse_mat

    !> Pointers to beginning of cols in IA and VAL.
    integer(psb_ipk_), allocatable :: icp(:)
    !> Row indices.
    integer(psb_ipk_), allocatable :: ia(:)
    !> Coefficient values.
    complex(psb_dpk_), allocatable :: val(:)

  contains
    procedure, pass(a) :: is_by_cols  => z_csc_is_by_cols
    procedure, pass(a) :: get_size    => z_csc_get_size
    procedure, pass(a) :: get_nzeros  => z_csc_get_nzeros
    procedure, nopass  :: get_fmt     => z_csc_get_fmt
    procedure, pass(a) :: sizeof      => z_csc_sizeof
    procedure, pass(a) :: csmm        => psb_z_csc_csmm
    procedure, pass(a) :: csmv        => psb_z_csc_csmv
    procedure, pass(a) :: inner_cssm  => psb_z_csc_cssm
    procedure, pass(a) :: inner_cssv  => psb_z_csc_cssv
    procedure, pass(a) :: scals       => psb_z_csc_scals
    procedure, pass(a) :: scalv       => psb_z_csc_scal
    procedure, pass(a) :: maxval      => psb_z_csc_maxval
    procedure, pass(a) :: spnm1       => psb_z_csc_csnm1
    procedure, pass(a) :: rowsum      => psb_z_csc_rowsum
    procedure, pass(a) :: arwsum      => psb_z_csc_arwsum
    procedure, pass(a) :: colsum      => psb_z_csc_colsum
    procedure, pass(a) :: aclsum      => psb_z_csc_aclsum
    procedure, pass(a) :: reallocate_nz => psb_z_csc_reallocate_nz
    procedure, pass(a) :: allocate_mnnz => psb_z_csc_allocate_mnnz
    procedure, pass(a) :: cp_to_coo   => psb_z_cp_csc_to_coo
    procedure, pass(a) :: cp_from_coo => psb_z_cp_csc_from_coo
    procedure, pass(a) :: cp_to_fmt   => psb_z_cp_csc_to_fmt
    procedure, pass(a) :: cp_from_fmt => psb_z_cp_csc_from_fmt
    procedure, pass(a) :: mv_to_coo   => psb_z_mv_csc_to_coo
    procedure, pass(a) :: mv_from_coo => psb_z_mv_csc_from_coo
    procedure, pass(a) :: mv_to_fmt   => psb_z_mv_csc_to_fmt
    procedure, pass(a) :: mv_from_fmt => psb_z_mv_csc_from_fmt
    procedure, pass(a) :: clean_zeros => psb_z_csc_clean_zeros
    procedure, pass(a) :: csput_a      => psb_z_csc_csput_a
    procedure, pass(a) :: get_diag    => psb_z_csc_get_diag
    procedure, pass(a) :: csgetptn    => psb_z_csc_csgetptn
    procedure, pass(a) :: csgetrow   => psb_z_csc_csgetrow
    procedure, pass(a) :: get_nz_col  => z_csc_get_nz_col
    procedure, pass(a) :: reinit      => psb_z_csc_reinit
    procedure, pass(a) :: trim        => psb_z_csc_trim
    procedure, pass(a) :: print       => psb_z_csc_print
    procedure, pass(a) :: free        => z_csc_free
    procedure, pass(a) :: mold        => psb_z_csc_mold

  end type psb_z_csc_sparse_mat

  private :: z_csc_get_nzeros, z_csc_free,  z_csc_get_fmt, &
       & z_csc_get_size, z_csc_sizeof, z_csc_get_nz_col

  !> \namespace  psb_base_mod  \class  psb_z_csc_sparse_mat
  !! \extends psb_z_base_mat_mod::psb_z_base_sparse_mat
  !!
  !! psb_z_csc_sparse_mat type and the related methods.
  !!
  type, extends(psb_lz_base_sparse_mat) :: psb_lz_csc_sparse_mat

    !> Pointers to beginning of cols in IA and VAL.
    integer(psb_lpk_), allocatable :: icp(:)
    !> Row indices.
    integer(psb_lpk_), allocatable :: ia(:)
    !> Coefficient values.
    complex(psb_dpk_), allocatable :: val(:)

  contains
    procedure, pass(a) :: is_by_cols  => lz_csc_is_by_cols
    procedure, pass(a) :: get_size    => lz_csc_get_size
    procedure, pass(a) :: get_nzeros  => lz_csc_get_nzeros
    procedure, nopass  :: get_fmt     => lz_csc_get_fmt
    procedure, pass(a) :: sizeof      => lz_csc_sizeof
    procedure, pass(a) :: scals       => psb_lz_csc_scals
    procedure, pass(a) :: scalv       => psb_lz_csc_scal
    procedure, pass(a) :: maxval      => psb_lz_csc_maxval
    procedure, pass(a) :: spnm1       => psb_lz_csc_csnm1
    procedure, pass(a) :: rowsum      => psb_lz_csc_rowsum
    procedure, pass(a) :: arwsum      => psb_lz_csc_arwsum
    procedure, pass(a) :: colsum      => psb_lz_csc_colsum
    procedure, pass(a) :: aclsum      => psb_lz_csc_aclsum
    procedure, pass(a) :: reallocate_nz => psb_lz_csc_reallocate_nz
    procedure, pass(a) :: allocate_mnnz => psb_lz_csc_allocate_mnnz
    procedure, pass(a) :: cp_to_coo   => psb_lz_cp_csc_to_coo
    procedure, pass(a) :: cp_from_coo => psb_lz_cp_csc_from_coo
    procedure, pass(a) :: cp_to_fmt   => psb_lz_cp_csc_to_fmt
    procedure, pass(a) :: cp_from_fmt => psb_lz_cp_csc_from_fmt
    procedure, pass(a) :: mv_to_coo   => psb_lz_mv_csc_to_coo
    procedure, pass(a) :: mv_from_coo => psb_lz_mv_csc_from_coo
    procedure, pass(a) :: mv_to_fmt   => psb_lz_mv_csc_to_fmt
    procedure, pass(a) :: mv_from_fmt => psb_lz_mv_csc_from_fmt
    procedure, pass(a) :: clean_zeros => psb_lz_csc_clean_zeros
    procedure, pass(a) :: csput_a     => psb_lz_csc_csput_a
    procedure, pass(a) :: get_diag    => psb_lz_csc_get_diag
    procedure, pass(a) :: csgetptn    => psb_lz_csc_csgetptn
    procedure, pass(a) :: csgetrow    => psb_lz_csc_csgetrow
    procedure, pass(a) :: get_nz_col  => lz_csc_get_nz_col
    procedure, pass(a) :: reinit      => psb_lz_csc_reinit
    procedure, pass(a) :: trim        => psb_lz_csc_trim
    procedure, pass(a) :: print       => psb_lz_csc_print
    procedure, pass(a) :: free        => lz_csc_free
    procedure, pass(a) :: mold        => psb_lz_csc_mold

  end type psb_lz_csc_sparse_mat

  private :: lz_csc_get_nzeros, lz_csc_free,  lz_csc_get_fmt, &
       & lz_csc_get_size, lz_csc_sizeof, lz_csc_get_nz_col

  !> \memberof psb_z_csc_sparse_mat
  !| \see psb_base_mat_mod::psb_base_reallocate_nz
  interface
    subroutine  psb_z_csc_reallocate_nz(nz,a)
      import
      integer(psb_ipk_), intent(in) :: nz
      class(psb_z_csc_sparse_mat), intent(inout) :: a
    end subroutine psb_z_csc_reallocate_nz
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !| \see psb_base_mat_mod::psb_base_reinit
  interface
    subroutine psb_z_csc_reinit(a,clear)
      import
      class(psb_z_csc_sparse_mat), intent(inout) :: a
      logical, intent(in), optional :: clear
    end subroutine psb_z_csc_reinit
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !| \see psb_base_mat_mod::psb_base_trim
  interface
    subroutine  psb_z_csc_trim(a)
      import
      class(psb_z_csc_sparse_mat), intent(inout) :: a
    end subroutine psb_z_csc_trim
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !| \see psb_base_mat_mod::psb_base_mold
  interface
    subroutine psb_z_csc_mold(a,b,info)
      import
      class(psb_z_csc_sparse_mat), intent(in)                  :: a
      class(psb_z_base_sparse_mat), intent(inout), allocatable :: b
      integer(psb_ipk_), intent(out)                           :: info
    end subroutine psb_z_csc_mold
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !| \see psb_base_mat_mod::psb_base_allocate_mnnz
  interface
    subroutine  psb_z_csc_allocate_mnnz(m,n,a,nz)
      import
      integer(psb_ipk_), intent(in) :: m,n
      class(psb_z_csc_sparse_mat), intent(inout) :: a
      integer(psb_ipk_), intent(in), optional :: nz
    end subroutine psb_z_csc_allocate_mnnz
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_print
  interface
    subroutine psb_z_csc_print(iout,a,iv,head,ivr,ivc)
      import
      integer(psb_ipk_), intent(in)               :: iout
      class(psb_z_csc_sparse_mat), intent(in) :: a
      integer(psb_lpk_), intent(in), optional     :: iv(:)
      character(len=*), optional        :: head
      integer(psb_lpk_), intent(in), optional     :: ivr(:), ivc(:)
    end subroutine psb_z_csc_print
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_cp_to_coo
  interface
    subroutine psb_z_cp_csc_to_coo(a,b,info)
      import
      class(psb_z_csc_sparse_mat), intent(in) :: a
      class(psb_z_coo_sparse_mat), intent(inout) :: b
      integer(psb_ipk_), intent(out)            :: info
    end subroutine psb_z_cp_csc_to_coo
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_cp_from_coo
  interface
    subroutine psb_z_cp_csc_from_coo(a,b,info)
      import
      class(psb_z_csc_sparse_mat), intent(inout) :: a
      class(psb_z_coo_sparse_mat), intent(in)    :: b
      integer(psb_ipk_), intent(out)               :: info
    end subroutine psb_z_cp_csc_from_coo
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_cp_to_fmt
  interface
    subroutine psb_z_cp_csc_to_fmt(a,b,info)
      import
      class(psb_z_csc_sparse_mat), intent(in)   :: a
      class(psb_z_base_sparse_mat), intent(inout) :: b
      integer(psb_ipk_), intent(out)                       :: info
    end subroutine psb_z_cp_csc_to_fmt
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_cp_from_fmt
  interface
    subroutine psb_z_cp_csc_from_fmt(a,b,info)
      import
      class(psb_z_csc_sparse_mat), intent(inout) :: a
      class(psb_z_base_sparse_mat), intent(in)   :: b
      integer(psb_ipk_), intent(out)                        :: info
    end subroutine psb_z_cp_csc_from_fmt
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_mv_to_coo
  interface
    subroutine psb_z_mv_csc_to_coo(a,b,info)
      import
      class(psb_z_csc_sparse_mat), intent(inout) :: a
      class(psb_z_coo_sparse_mat), intent(inout)   :: b
      integer(psb_ipk_), intent(out)            :: info
    end subroutine psb_z_mv_csc_to_coo
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_mv_from_coo
  interface
    subroutine psb_z_mv_csc_from_coo(a,b,info)
      import
      class(psb_z_csc_sparse_mat), intent(inout) :: a
      class(psb_z_coo_sparse_mat), intent(inout) :: b
      integer(psb_ipk_), intent(out)                        :: info
    end subroutine psb_z_mv_csc_from_coo
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_mv_to_fmt
  interface
    subroutine psb_z_mv_csc_to_fmt(a,b,info)
      import
      class(psb_z_csc_sparse_mat), intent(inout) :: a
      class(psb_z_base_sparse_mat), intent(inout)  :: b
      integer(psb_ipk_), intent(out)                        :: info
    end subroutine psb_z_mv_csc_to_fmt
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_mv_from_fmt
  interface
    subroutine psb_z_mv_csc_from_fmt(a,b,info)
      import
      class(psb_z_csc_sparse_mat), intent(inout)  :: a
      class(psb_z_base_sparse_mat), intent(inout) :: b
      integer(psb_ipk_), intent(out)                         :: info
    end subroutine psb_z_mv_csc_from_fmt
  end interface

  !
  !>
  !! \memberof  psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_clean_zeros
  !
  interface
    subroutine  psb_z_csc_clean_zeros(a, info)
      import
      class(psb_z_csc_sparse_mat), intent(inout) :: a
      integer(psb_ipk_), intent(out)              :: info
    end subroutine psb_z_csc_clean_zeros
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_cp_from
  interface
    subroutine psb_z_csc_cp_from(a,b)
      import
      class(psb_z_csc_sparse_mat), intent(inout) :: a
      type(psb_z_csc_sparse_mat), intent(in)   :: b
    end subroutine psb_z_csc_cp_from
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_mv_from
  interface
    subroutine psb_z_csc_mv_from(a,b)
      import
      class(psb_z_csc_sparse_mat), intent(inout)  :: a
      type(psb_z_csc_sparse_mat), intent(inout) :: b
    end subroutine psb_z_csc_mv_from
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_csput_a
  interface
    subroutine psb_z_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info)
      import
      class(psb_z_csc_sparse_mat), intent(inout) :: a
      complex(psb_dpk_), intent(in)      :: val(:)
      integer(psb_ipk_), intent(in)             :: nz,ia(:), ja(:),&
           &  imin,imax,jmin,jmax
      integer(psb_ipk_), intent(out)            :: info
    end subroutine psb_z_csc_csput_a
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_base_mat_mod::psb_base_csgetptn
  interface
    subroutine psb_z_csc_csgetptn(imin,imax,a,nz,ia,ja,info,&
         & jmin,jmax,iren,append,nzin,rscale,cscale)
      import
      class(psb_z_csc_sparse_mat), intent(in) :: a
      integer(psb_ipk_), intent(in)                  :: imin,imax
      integer(psb_ipk_), intent(out)                 :: nz
      integer(psb_ipk_), allocatable, intent(inout)  :: ia(:), ja(:)
      integer(psb_ipk_),intent(out)                  :: info
      logical, intent(in), optional        :: append
      integer(psb_ipk_), intent(in), optional        :: iren(:)
      integer(psb_ipk_), intent(in), optional        :: jmin,jmax, nzin
      logical, intent(in), optional        :: rscale,cscale
    end subroutine psb_z_csc_csgetptn
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_csgetrow
  interface
    subroutine psb_z_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
         & jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
      import :: psb_ipk_, psb_z_csc_sparse_mat, psb_dpk_
      class(psb_z_csc_sparse_mat), intent(in) :: a
      integer(psb_ipk_), intent(in)                  :: imin,imax
      integer(psb_ipk_), intent(out)                 :: nz
      integer(psb_ipk_), allocatable, intent(inout)  :: ia(:), ja(:)
      complex(psb_dpk_), allocatable,  intent(inout)    :: val(:)
      integer(psb_ipk_),intent(out)                  :: info
      logical, intent(in), optional        :: append
      integer(psb_ipk_), intent(in), optional        :: iren(:)
      integer(psb_ipk_), intent(in), optional        :: jmin,jmax, nzin
      logical, intent(in), optional        :: rscale,cscale,chksz
    end subroutine psb_z_csc_csgetrow
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_csgetblk
  interface
    subroutine psb_z_csc_csgetblk(imin,imax,a,b,info,&
       & jmin,jmax,iren,append,rscale,cscale,chksz)
      import
      class(psb_z_csc_sparse_mat), intent(in) :: a
      class(psb_z_coo_sparse_mat), intent(inout) :: b
      integer(psb_ipk_), intent(in)                  :: imin,imax
      integer(psb_ipk_),intent(out)                  :: info
      logical, intent(in), optional        :: append
      integer(psb_ipk_), intent(in), optional        :: iren(:)
      integer(psb_ipk_), intent(in), optional        :: jmin,jmax
      logical, intent(in), optional        :: rscale,cscale,chksz
    end subroutine psb_z_csc_csgetblk
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_cssv
  interface
    subroutine psb_z_csc_cssv(alpha,a,x,beta,y,info,trans)
      import
      class(psb_z_csc_sparse_mat), intent(in) :: a
      complex(psb_dpk_), intent(in)          :: alpha, beta, x(:)
      complex(psb_dpk_), intent(inout)       :: y(:)
      integer(psb_ipk_), intent(out)                :: info
      character, optional, intent(in)     :: trans
    end subroutine psb_z_csc_cssv
  end interface
  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_cssm
  interface
    subroutine psb_z_csc_cssm(alpha,a,x,beta,y,info,trans)
      import
      class(psb_z_csc_sparse_mat), intent(in) :: a
      complex(psb_dpk_), intent(in)          :: alpha, beta, x(:,:)
      complex(psb_dpk_), intent(inout)       :: y(:,:)
      integer(psb_ipk_), intent(out)                :: info
      character, optional, intent(in)     :: trans
    end subroutine psb_z_csc_cssm
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_csmv
  interface
    subroutine psb_z_csc_csmv(alpha,a,x,beta,y,info,trans)
      import
      class(psb_z_csc_sparse_mat), intent(in) :: a
      complex(psb_dpk_), intent(in)          :: alpha, beta, x(:)
      complex(psb_dpk_), intent(inout)       :: y(:)
      integer(psb_ipk_), intent(out)                :: info
      character, optional, intent(in)     :: trans
    end subroutine psb_z_csc_csmv
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_csmm
  interface
    subroutine psb_z_csc_csmm(alpha,a,x,beta,y,info,trans)
      import
      class(psb_z_csc_sparse_mat), intent(in) :: a
      complex(psb_dpk_), intent(in)          :: alpha, beta, x(:,:)
      complex(psb_dpk_), intent(inout)       :: y(:,:)
      integer(psb_ipk_), intent(out)                :: info
      character, optional, intent(in)     :: trans
    end subroutine psb_z_csc_csmm
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_maxval
  interface
    function psb_z_csc_maxval(a) result(res)
      import
      class(psb_z_csc_sparse_mat), intent(in) :: a
      real(psb_dpk_)         :: res
    end function psb_z_csc_maxval
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_csnm1
  interface
    function psb_z_csc_csnm1(a) result(res)
      import
      class(psb_z_csc_sparse_mat), intent(in) :: a
      real(psb_dpk_)         :: res
    end function psb_z_csc_csnm1
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_rowsum
  interface
    subroutine psb_z_csc_rowsum(d,a)
      import
      class(psb_z_csc_sparse_mat), intent(in) :: a
      complex(psb_dpk_), intent(out)              :: d(:)
    end subroutine psb_z_csc_rowsum
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_arwsum
  interface
    subroutine psb_z_csc_arwsum(d,a)
      import
      class(psb_z_csc_sparse_mat), intent(in) :: a
      real(psb_dpk_), intent(out)              :: d(:)
    end subroutine psb_z_csc_arwsum
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_colsum
  interface
    subroutine psb_z_csc_colsum(d,a)
      import
      class(psb_z_csc_sparse_mat), intent(in) :: a
      complex(psb_dpk_), intent(out)              :: d(:)
    end subroutine psb_z_csc_colsum
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_aclsum
  interface
    subroutine psb_z_csc_aclsum(d,a)
      import
      class(psb_z_csc_sparse_mat), intent(in) :: a
      real(psb_dpk_), intent(out)              :: d(:)
    end subroutine psb_z_csc_aclsum
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_get_diag
  interface
    subroutine psb_z_csc_get_diag(a,d,info)
      import
      class(psb_z_csc_sparse_mat), intent(in) :: a
      complex(psb_dpk_), intent(out)     :: d(:)
      integer(psb_ipk_), intent(out)            :: info
    end subroutine psb_z_csc_get_diag
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_scal
  interface
    subroutine psb_z_csc_scal(d,a,info,side)
      import
      class(psb_z_csc_sparse_mat), intent(inout) :: a
      complex(psb_dpk_), intent(in)      :: d(:)
      integer(psb_ipk_), intent(out)            :: info
      character, intent(in), optional :: side
    end subroutine psb_z_csc_scal
  end interface

  !> \memberof psb_z_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_z_base_scals
  interface
    subroutine psb_z_csc_scals(d,a,info)
      import
      class(psb_z_csc_sparse_mat), intent(inout) :: a
      complex(psb_dpk_), intent(in)      :: d
      integer(psb_ipk_), intent(out)            :: info
    end subroutine psb_z_csc_scals
  end interface

  !
  ! lz
  !
  !> \memberof psb_lz_csc_sparse_mat
  !| \see psb_base_mat_mod::psb_base_reallocate_nz
  interface
    subroutine  psb_lz_csc_reallocate_nz(nz,a)
      import
      integer(psb_lpk_), intent(in) :: nz
      class(psb_lz_csc_sparse_mat), intent(inout) :: a
    end subroutine psb_lz_csc_reallocate_nz
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !| \see psb_base_mat_mod::psb_base_reinit
  interface
    subroutine psb_lz_csc_reinit(a,clear)
      import
      class(psb_lz_csc_sparse_mat), intent(inout) :: a
      logical, intent(in), optional :: clear
    end subroutine psb_lz_csc_reinit
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !| \see psb_base_mat_mod::psb_base_trim
  interface
    subroutine  psb_lz_csc_trim(a)
      import
      class(psb_lz_csc_sparse_mat), intent(inout) :: a
    end subroutine psb_lz_csc_trim
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !| \see psb_base_mat_mod::psb_base_mold
  interface
    subroutine psb_lz_csc_mold(a,b,info)
      import
      class(psb_lz_csc_sparse_mat), intent(in)                  :: a
      class(psb_lz_base_sparse_mat), intent(inout), allocatable :: b
      integer(psb_ipk_), intent(out)                           :: info
    end subroutine psb_lz_csc_mold
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !| \see psb_base_mat_mod::psb_base_allocate_mnnz
  interface
    subroutine  psb_lz_csc_allocate_mnnz(m,n,a,nz)
      import
      integer(psb_lpk_), intent(in) :: m,n
      class(psb_lz_csc_sparse_mat), intent(inout) :: a
      integer(psb_lpk_), intent(in), optional :: nz
    end subroutine psb_lz_csc_allocate_mnnz
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_lz_base_mat_mod::psb_lz_base_print
  interface
    subroutine psb_lz_csc_print(iout,a,iv,head,ivr,ivc)
      import
      integer(psb_ipk_), intent(in)               :: iout
      class(psb_lz_csc_sparse_mat), intent(in) :: a
      integer(psb_lpk_), intent(in), optional     :: iv(:)
      character(len=*), optional        :: head
      integer(psb_lpk_), intent(in), optional     :: ivr(:), ivc(:)
    end subroutine psb_lz_csc_print
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_lz_base_mat_mod::psb_lz_base_cp_to_coo
  interface
    subroutine psb_lz_cp_csc_to_coo(a,b,info)
      import
      class(psb_lz_csc_sparse_mat), intent(in) :: a
      class(psb_lz_coo_sparse_mat), intent(inout) :: b
      integer(psb_ipk_), intent(out)            :: info
    end subroutine psb_lz_cp_csc_to_coo
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_lz_base_mat_mod::psb_lz_base_cp_from_coo
  interface
    subroutine psb_lz_cp_csc_from_coo(a,b,info)
      import
      class(psb_lz_csc_sparse_mat), intent(inout) :: a
      class(psb_lz_coo_sparse_mat), intent(in)    :: b
      integer(psb_ipk_), intent(out)               :: info
    end subroutine psb_lz_cp_csc_from_coo
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_lz_base_mat_mod::psb_lz_base_cp_to_fmt
  interface
    subroutine psb_lz_cp_csc_to_fmt(a,b,info)
      import
      class(psb_lz_csc_sparse_mat), intent(in)   :: a
      class(psb_lz_base_sparse_mat), intent(inout) :: b
      integer(psb_ipk_), intent(out)                       :: info
    end subroutine psb_lz_cp_csc_to_fmt
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_lz_base_mat_mod::psb_lz_base_cp_from_fmt
  interface
    subroutine psb_lz_cp_csc_from_fmt(a,b,info)
      import
      class(psb_lz_csc_sparse_mat), intent(inout) :: a
      class(psb_lz_base_sparse_mat), intent(in)   :: b
      integer(psb_ipk_), intent(out)                        :: info
    end subroutine psb_lz_cp_csc_from_fmt
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_lz_base_mat_mod::psb_lz_base_mv_to_coo
  interface
    subroutine psb_lz_mv_csc_to_coo(a,b,info)
      import
      class(psb_lz_csc_sparse_mat), intent(inout) :: a
      class(psb_lz_coo_sparse_mat), intent(inout)   :: b
      integer(psb_ipk_), intent(out)            :: info
    end subroutine psb_lz_mv_csc_to_coo
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_lz_base_mat_mod::psb_lz_base_mv_from_coo
  interface
    subroutine psb_lz_mv_csc_from_coo(a,b,info)
      import
      class(psb_lz_csc_sparse_mat), intent(inout) :: a
      class(psb_lz_coo_sparse_mat), intent(inout) :: b
      integer(psb_ipk_), intent(out)                        :: info
    end subroutine psb_lz_mv_csc_from_coo
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_lz_base_mat_mod::psb_lz_base_mv_to_fmt
  interface
    subroutine psb_lz_mv_csc_to_fmt(a,b,info)
      import
      class(psb_lz_csc_sparse_mat), intent(inout) :: a
      class(psb_lz_base_sparse_mat), intent(inout)  :: b
      integer(psb_ipk_), intent(out)                        :: info
    end subroutine psb_lz_mv_csc_to_fmt
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_lz_base_mat_mod::psb_lz_base_mv_from_fmt
  interface
    subroutine psb_lz_mv_csc_from_fmt(a,b,info)
      import
      class(psb_lz_csc_sparse_mat), intent(inout)  :: a
      class(psb_lz_base_sparse_mat), intent(inout) :: b
      integer(psb_ipk_), intent(out)                         :: info
    end subroutine psb_lz_mv_csc_from_fmt
  end interface

  !
  !>
  !! \memberof  psb_lz_csc_sparse_mat
  !! \see psb_lz_base_mat_mod::psb_lz_base_clean_zeros
  !
  interface
    subroutine  psb_lz_csc_clean_zeros(a, info)
      import
      class(psb_lz_csc_sparse_mat), intent(inout) :: a
      integer(psb_ipk_), intent(out)              :: info
    end subroutine psb_lz_csc_clean_zeros
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_lz_base_mat_mod::psb_lz_base_cp_from
  interface
    subroutine psb_lz_csc_cp_from(a,b)
      import
      class(psb_lz_csc_sparse_mat), intent(inout) :: a
      type(psb_lz_csc_sparse_mat), intent(in)   :: b
    end subroutine psb_lz_csc_cp_from
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_lz_base_mat_mod::psb_lz_base_mv_from
  interface
    subroutine psb_lz_csc_mv_from(a,b)
      import
      class(psb_lz_csc_sparse_mat), intent(inout)  :: a
      type(psb_lz_csc_sparse_mat), intent(inout) :: b
    end subroutine psb_lz_csc_mv_from
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_lz_base_mat_mod::psb_lz_base_csput_a
  interface
    subroutine psb_lz_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info)
      import
      class(psb_lz_csc_sparse_mat), intent(inout) :: a
      complex(psb_dpk_), intent(in)      :: val(:)
      integer(psb_lpk_), intent(in)             :: nz,ia(:), ja(:),&
           &  imin,imax,jmin,jmax
      integer(psb_ipk_), intent(out)            :: info
    end subroutine psb_lz_csc_csput_a
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_base_mat_mod::psb_base_csgetptn
  interface
    subroutine psb_lz_csc_csgetptn(imin,imax,a,nz,ia,ja,info,&
         & jmin,jmax,iren,append,nzin,rscale,cscale)
      import
      class(psb_lz_csc_sparse_mat), intent(in) :: a
      integer(psb_lpk_), intent(in)                  :: imin,imax
      integer(psb_lpk_), intent(out)                 :: nz
      integer(psb_lpk_), allocatable, intent(inout)  :: ia(:), ja(:)
      integer(psb_ipk_),intent(out)                  :: info
      logical, intent(in), optional        :: append
      integer(psb_lpk_), intent(in), optional        :: iren(:)
      integer(psb_lpk_), intent(in), optional        :: jmin,jmax, nzin
      logical, intent(in), optional        :: rscale,cscale
    end subroutine psb_lz_csc_csgetptn
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_lz_base_mat_mod::psb_lz_base_csgetrow
  interface
    subroutine psb_lz_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
         & jmin,jmax,iren,append,nzin,rscale,cscale)
      import
      class(psb_lz_csc_sparse_mat), intent(in) :: a
      integer(psb_lpk_), intent(in)                  :: imin,imax
      integer(psb_lpk_), intent(out)                 :: nz
      integer(psb_lpk_), allocatable, intent(inout)  :: ia(:), ja(:)
      complex(psb_dpk_), allocatable,  intent(inout)    :: val(:)
      integer(psb_ipk_),intent(out)                  :: info
      logical, intent(in), optional        :: append
      integer(psb_lpk_), intent(in), optional        :: iren(:)
      integer(psb_lpk_), intent(in), optional        :: jmin,jmax, nzin
      logical, intent(in), optional        :: rscale,cscale
    end subroutine psb_lz_csc_csgetrow
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_lz_base_mat_mod::psb_lz_base_csgetblk
  interface
    subroutine psb_lz_csc_csgetblk(imin,imax,a,b,info,&
       & jmin,jmax,iren,append,rscale,cscale)
      import
      class(psb_lz_csc_sparse_mat), intent(in) :: a
      class(psb_lz_coo_sparse_mat), intent(inout) :: b
      integer(psb_lpk_), intent(in)                  :: imin,imax
      integer(psb_ipk_),intent(out)                  :: info
      logical, intent(in), optional        :: append
      integer(psb_lpk_), intent(in), optional        :: iren(:)
      integer(psb_lpk_), intent(in), optional        :: jmin,jmax
      logical, intent(in), optional        :: rscale,cscale
    end subroutine psb_lz_csc_csgetblk
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_lz_base_mat_mod::psb_lz_base_get_diag
  interface
    subroutine psb_lz_csc_get_diag(a,d,info)
      import
      class(psb_lz_csc_sparse_mat), intent(in) :: a
      complex(psb_dpk_), intent(out)     :: d(:)
      integer(psb_ipk_), intent(out)            :: info
    end subroutine psb_lz_csc_get_diag
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_lz_base_maxval
  interface
    function psb_lz_csc_maxval(a) result(res)
      import
      class(psb_lz_csc_sparse_mat), intent(in) :: a
      real(psb_dpk_)         :: res
    end function psb_lz_csc_maxval
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_lz_base_csnm1
  interface
    function psb_lz_csc_csnm1(a) result(res)
      import
      class(psb_lz_csc_sparse_mat), intent(in) :: a
      real(psb_dpk_)         :: res
    end function psb_lz_csc_csnm1
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_lz_base_rowsum
  interface
    subroutine psb_lz_csc_rowsum(d,a)
      import
      class(psb_lz_csc_sparse_mat), intent(in) :: a
      complex(psb_dpk_), intent(out)              :: d(:)
    end subroutine psb_lz_csc_rowsum
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_lz_base_arwsum
  interface
    subroutine psb_lz_csc_arwsum(d,a)
      import
      class(psb_lz_csc_sparse_mat), intent(in) :: a
      real(psb_dpk_), intent(out)              :: d(:)
    end subroutine psb_lz_csc_arwsum
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_lz_base_colsum
  interface
    subroutine psb_lz_csc_colsum(d,a)
      import
      class(psb_lz_csc_sparse_mat), intent(in) :: a
      complex(psb_dpk_), intent(out)              :: d(:)
    end subroutine psb_lz_csc_colsum
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_z_base_mat_mod::psb_lz_base_aclsum
  interface
    subroutine psb_lz_csc_aclsum(d,a)
      import
      class(psb_lz_csc_sparse_mat), intent(in) :: a
      real(psb_dpk_), intent(out)              :: d(:)
    end subroutine psb_lz_csc_aclsum
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_lz_base_mat_mod::psb_lz_base_scal
  interface
    subroutine psb_lz_csc_scal(d,a,info,side)
      import
      class(psb_lz_csc_sparse_mat), intent(inout) :: a
      complex(psb_dpk_), intent(in)      :: d(:)
      integer(psb_ipk_), intent(out)            :: info
      character, intent(in), optional :: side
    end subroutine psb_lz_csc_scal
  end interface

  !> \memberof psb_lz_csc_sparse_mat
  !! \see psb_lz_base_mat_mod::psb_lz_base_scals
  interface
    subroutine psb_lz_csc_scals(d,a,info)
      import
      class(psb_lz_csc_sparse_mat), intent(inout) :: a
      complex(psb_dpk_), intent(in)      :: d
      integer(psb_ipk_), intent(out)            :: info
    end subroutine psb_lz_csc_scals
  end interface

contains

  ! == ===================================
  !
  !
  !
  ! Getters
  !
  !
  !
  !
  !
  ! == ===================================

  function z_csc_is_by_cols(a) result(res)
    implicit none
    class(psb_z_csc_sparse_mat), intent(in) :: a
    logical  :: res
    res = .true.

  end function z_csc_is_by_cols

  function z_csc_sizeof(a) result(res)
    implicit none
    class(psb_z_csc_sparse_mat), intent(in) :: a
    integer(psb_epk_) :: res
    res = 2 * psb_sizeof_ip
    res = res + (2*psb_sizeof_dp)  * psb_size(a%val)
    res = res + psb_sizeof_ip * psb_size(a%icp)
    res = res + psb_sizeof_ip * psb_size(a%ia)

  end function z_csc_sizeof

  function z_csc_get_fmt() result(res)
    implicit none
    character(len=5) :: res
    res = 'CSC'
  end function z_csc_get_fmt

  function z_csc_get_nzeros(a) result(res)
    implicit none
    class(psb_z_csc_sparse_mat), intent(in) :: a
    integer(psb_ipk_) :: res
    res = a%icp(a%get_ncols()+1)-1
  end function z_csc_get_nzeros

  function z_csc_get_size(a) result(res)
    implicit none
    class(psb_z_csc_sparse_mat), intent(in) :: a
    integer(psb_ipk_) :: res

    res = -1

    if (allocated(a%ia)) then
      res = size(a%ia)
    end if
    if (allocated(a%val)) then
      if (res >= 0) then
        res = min(res,size(a%val))
      else
        res = size(a%val)
      end if
    end if

  end function z_csc_get_size

  function  z_csc_get_nz_col(idx,a) result(res)
    use psb_const_mod
    implicit none

    class(psb_z_csc_sparse_mat), intent(in) :: a
    integer(psb_ipk_), intent(in)                  :: idx
    integer(psb_ipk_) :: res

    res = 0

    if ((1<=idx).and.(idx<=a%get_ncols())) then
      res = a%icp(idx+1)-a%icp(idx)
    end if

  end function z_csc_get_nz_col

  ! == ===================================
  !
  !
  !
  ! Data management
  !
  !
  !
  !
  !
  ! == ===================================

  subroutine  z_csc_free(a)
    implicit none

    class(psb_z_csc_sparse_mat), intent(inout) :: a

    if (allocated(a%icp)) deallocate(a%icp)
    if (allocated(a%ia)) deallocate(a%ia)
    if (allocated(a%val)) deallocate(a%val)
    call a%set_null()
    call a%set_nrows(0_psb_ipk_)
    call a%set_ncols(0_psb_ipk_)

    return

  end subroutine z_csc_free

  ! == ===================================
  !
  !
  !
  ! Getters
  !
  !
  !
  !
  !
  ! == ===================================

  function lz_csc_is_by_cols(a) result(res)
    implicit none
    class(psb_lz_csc_sparse_mat), intent(in) :: a
    logical  :: res
    res = .true.

  end function lz_csc_is_by_cols

  !
  ! lz
  !

  function lz_csc_sizeof(a) result(res)
    implicit none
    class(psb_lz_csc_sparse_mat), intent(in) :: a
    integer(psb_epk_) :: res
    res = 2*psb_sizeof_lp
    res = res + (2*psb_sizeof_dp)  * psb_size(a%val)
    res = res + psb_sizeof_lp * psb_size(a%icp)
    res = res + psb_sizeof_lp * psb_size(a%ia)

  end function lz_csc_sizeof

  function lz_csc_get_fmt() result(res)
    implicit none
    character(len=5) :: res
    res = 'CSC'
  end function lz_csc_get_fmt

  function lz_csc_get_nzeros(a) result(res)
    implicit none
    class(psb_lz_csc_sparse_mat), intent(in) :: a
    integer(psb_lpk_) :: res
    res = a%icp(a%get_ncols()+1)-1
  end function lz_csc_get_nzeros

  function lz_csc_get_size(a) result(res)
    implicit none
    class(psb_lz_csc_sparse_mat), intent(in) :: a
    integer(psb_lpk_) :: res

    res = -1

    if (allocated(a%ia)) then
      res = size(a%ia)
    end if
    if (allocated(a%val)) then
      if (res >= 0) then
        res = min(res,size(a%val))
      else
        res = size(a%val)
      end if
    end if

  end function lz_csc_get_size

  function  lz_csc_get_nz_col(idx,a) result(res)
    use psb_const_mod
    implicit none

    class(psb_lz_csc_sparse_mat), intent(in) :: a
    integer(psb_lpk_), intent(in)                  :: idx
    integer(psb_lpk_) :: res

    res = 0

    if ((1<=idx).and.(idx<=a%get_ncols())) then
      res = a%icp(idx+1)-a%icp(idx)
    end if

  end function lz_csc_get_nz_col

  ! == ===================================
  !
  !
  !
  ! Data management
  !
  !
  !
  !
  !
  ! == ===================================

  subroutine  lz_csc_free(a)
    implicit none

    class(psb_lz_csc_sparse_mat), intent(inout) :: a

    if (allocated(a%icp)) deallocate(a%icp)
    if (allocated(a%ia)) deallocate(a%ia)
    if (allocated(a%val)) deallocate(a%val)
    call a%set_null()
    call a%set_nrows(0_psb_lpk_)
    call a%set_ncols(0_psb_lpk_)

    return

  end subroutine lz_csc_free

end module psb_z_csc_mat_mod


text:
*DECK SPINCW
      SUBROUTINE SPINCW (MRELAS, NVARS, LMX, LBM, NPP, JSTRT, IBASIS,
     +   IMAT, IBRC, IPR, IWR, IND, IBB, COSTSC, GG, ERDNRM, DULNRM,
     +   AMAT, BASMAT, CSC, WR, WW, RZ, RG, COSTS, COLNRM, DUALS,
     +   STPEDG)
C***BEGIN PROLOGUE  SPINCW
C***SUBSIDIARY
C***PURPOSE  Subsidiary to SPLP
C***LIBRARY   SLATEC
C***TYPE      SINGLE PRECISION (SPINCW-S, DPINCW-D)
C***AUTHOR  (UNKNOWN)
C***DESCRIPTION
C
C     THE EDITING REQUIRED TO CONVERT THIS SUBROUTINE FROM SINGLE TO
C     DOUBLE PRECISION INVOLVES THE FOLLOWING CHARACTER STRING CHANGES.
C
C     USE AN EDITING COMMAND (CHANGE) /STRING-1/(TO)STRING-2/,
C     REAL (12 BLANKS)/DOUBLE PRECISION/,/SCOPY/DCOPY/,/SDOT/DDOT/.
C
C     THIS SUBPROGRAM IS PART OF THE SPLP( ) PACKAGE.
C     IT IMPLEMENTS THE PROCEDURE (INITIALIZE REDUCED COSTS AND
C     STEEPEST EDGE WEIGHTS).
C
C***SEE ALSO  SPLP
C***ROUTINES CALLED  IPLOC, LA05BS, PRWPGE, SCOPY, SDOT
C***REVISION HISTORY  (YYMMDD)
C   811215  DATE WRITTEN
C   890531  Changed all specific intrinsics to generic.  (WRB)
C   890605  Removed unreferenced labels.  (WRB)
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   900328  Added TYPE section.  (WRB)
C***END PROLOGUE  SPINCW
      INTEGER IBASIS(*),IMAT(*),IBRC(LBM,2),IPR(*),IWR(*),IND(*),IBB(*)
      REAL             AMAT(*),BASMAT(*),CSC(*),WR(*),WW(*),RZ(*),RG(*),
     * COSTS(*),COLNRM(*),DUALS(*),COSTSC,ERDNRM,DULNRM,GG,ONE,RZJ,
     * SCALR,ZERO,RCOST
      LOGICAL STPEDG,PAGEPL,TRANS
C***FIRST EXECUTABLE STATEMENT  SPINCW
      LPG=LMX-(NVARS+4)
      ZERO=0.
      ONE=1.
C
C     FORM REDUCED COSTS, RZ(*), AND STEEPEST EDGE WEIGHTS, RG(*).
      PAGEPL=.TRUE.
      RZ(1)=ZERO
      CALL SCOPY(NVARS+MRELAS,RZ,0,RZ,1)
      RG(1)=ONE
      CALL SCOPY(NVARS+MRELAS,RG,0,RG,1)
      NNEGRC=0
      J=JSTRT
20002 IF (.NOT.(IBB(J).LE.0)) GO TO 20004
      PAGEPL=.TRUE.
      GO TO 20005
C
C     THESE ARE NONBASIC INDEPENDENT VARIABLES. THE COLS. ARE IN SPARSE
C     MATRIX FORMAT.
20004 IF (.NOT.(J.LE.NVARS)) GO TO 20007
      RZJ=COSTSC*COSTS(J)
      WW(1)=ZERO
      CALL SCOPY(MRELAS,WW,0,WW,1)
      IF (.NOT.(J.EQ.1)) GO TO 20010
      ILOW=NVARS+5
      GO TO 20011
20010 ILOW=IMAT(J+3)+1
20011 CONTINUE
      IF (.NOT.(PAGEPL)) GO TO 20013
      IL1=IPLOC(ILOW,AMAT,IMAT)
      IF (.NOT.(IL1.GE.LMX-1)) GO TO 20016
      ILOW=ILOW+2
      IL1=IPLOC(ILOW,AMAT,IMAT)
20016 CONTINUE
      IPAGE=ABS(IMAT(LMX-1))
      GO TO 20014
20013 IL1=IHI+1
20014 CONTINUE
      IHI=IMAT(J+4)-(ILOW-IL1)
20019 IU1=MIN(LMX-2,IHI)
      IF (.NOT.(IL1.GT.IU1)) GO TO 20021
      GO TO 20020
20021 CONTINUE
      DO 60 I=IL1,IU1
      RZJ=RZJ-AMAT(I)*DUALS(IMAT(I))
      WW(IMAT(I))=AMAT(I)*CSC(J)
60    CONTINUE
      IF (.NOT.(IHI.LE.LMX-2)) GO TO 20024
      GO TO 20020
20024 CONTINUE
      IPAGE=IPAGE+1
      KEY=1
      CALL PRWPGE(KEY,IPAGE,LPG,AMAT,IMAT)
      IL1=NVARS+5
      IHI=IHI-LPG
      GO TO 20019
20020 PAGEPL=IHI.EQ.(LMX-2)
      RZ(J)=RZJ*CSC(J)
      IF (.NOT.(STPEDG)) GO TO 20027
      TRANS=.FALSE.
      CALL LA05BS(BASMAT,IBRC,LBM,MRELAS,IPR,IWR,WR,GG,WW,TRANS)
      RG(J)=SDOT(MRELAS,WW,1,WW,1)+ONE
20027 CONTINUE
C
C     THESE ARE NONBASIC DEPENDENT VARIABLES. THE COLS. ARE IMPLICITLY
C     DEFINED.
      GO TO 20008
20007 PAGEPL=.TRUE.
      WW(1)=ZERO
      CALL SCOPY(MRELAS,WW,0,WW,1)
      SCALR=-ONE
      IF (IND(J).EQ.2) SCALR=ONE
      I=J-NVARS
      RZ(J)=-SCALR*DUALS(I)
      WW(I)=SCALR
      IF (.NOT.(STPEDG)) GO TO 20030
      TRANS=.FALSE.
      CALL LA05BS(BASMAT,IBRC,LBM,MRELAS,IPR,IWR,WR,GG,WW,TRANS)
      RG(J)=SDOT(MRELAS,WW,1,WW,1)+ONE
20030 CONTINUE
      CONTINUE
20008 CONTINUE
C
20005 RCOST=RZ(J)
      IF (MOD(IBB(J),2).EQ.0) RCOST=-RCOST
      IF (IND(J).EQ.4) RCOST=-ABS(RCOST)
      CNORM=ONE
      IF (J.LE.NVARS) CNORM=COLNRM(J)
      IF (RCOST+ERDNRM*DULNRM*CNORM.LT.ZERO) NNEGRC=NNEGRC+1
      J=MOD(J,MRELAS+NVARS)+1
      IF (.NOT.(NNEGRC.GE.NPP .OR. J.EQ.JSTRT)) GO TO 20033
      GO TO 20003
20033 GO TO 20002
20003 JSTRT=J
      RETURN
      END


text:
! =============================================================================
!                       Test Jacobi diagonalisation
!
!       This unit test checks compares the Jacobi diagonalisation with
!       NumPy (numpy.linalg.eigh) (version 1.20.2)
! =============================================================================
program test_jacobi_2
    use unit_test
    use constants, only : zero
    use jacobi
    implicit none

    double precision     :: error
    integer              :: n, k, num
    double precision     :: V(3, 3)
    double precision     :: B(3, 3), D(3)
    double precision     :: Q(3, 3), EV(3) ! reference

    error = zero

    call fopen

    do n = 1, num

        call read_next_line

        call jacobi_diagonalise(B, D, V)

        ! check eigenvalues
        error = max(error, dabs(EV(1) - D(1)) &
                         + dabs(EV(2) - D(2)) &
                         + dabs(EV(3) - D(3)))

        ! check eigenvectors
        do k = 1, 3
            if (Q(1, k) / V(1, k) < zero) then
                ! opposite sign
                Q(:, k) = - Q(:, k)
            endif
            error = max(error, sum(dabs(Q(:, k) - V(:, k))))
        enddo
    enddo

    call fclose

    call print_result_dp('Test Jacobi 2', error, atol=dble(1.0e-12))

    contains

        subroutine fopen
            call open_file('../share/B.asc', 1234)
            read(1234, *) num

            call open_file('../share/V.asc', 1235)
            read(1235, *) n

            if (num .ne. n) then
                ! we do not perform this test
                stop
            endif

            call open_file('../share/D.asc', 1236)
            read(1236, *) n

            if (num .ne. n) then
                ! we do not perform this test
                stop
            endif
        end subroutine fopen

        subroutine open_file(fname, unit)
            character(*), intent(in) :: fname
            integer,      intent(in) :: unit
            logical                  :: exists = .false.

            inquire(file=fname, exist=exists)
            if (.not. exists) then
                call fclose
                ! we do not perform this test
                stop
            endif
            open(unit=unit, file=fname)
        end subroutine open_file

        subroutine fclose
            integer :: unit
            ! 20 October 2021
            ! https://stackoverflow.com/questions/31941681/check-whether-file-has-been-opened-already

            inquire(file='../share/B.asc', number=unit)
            if (unit == 1234) then
                close(1234)
            endif

            inquire(file='../share/V.asc', number=unit)
            if (unit == 1235) then
                close(1235)
            endif

            inquire(file='../share/D.asc', number=unit)
            if (unit == 1236) then
                close(1236)
            endif
        end subroutine fclose

        subroutine read_next_line
            ! B matrix
            read(1234, *) B(1, 1), B(1, 2), B(1, 3), B(2, 2), B(2, 3), B(3, 3)
            B(2, 1) = B(1, 2)
            B(3, 1) = B(1, 3)
            B(3, 2) = B(2, 3)

            ! eigenvectors
            read(1235, *) Q(:, 1), Q(:, 2), Q(:, 3)

            ! eigenvalues
            read(1236, *) EV(1), EV(2), EV(3)
        end subroutine read_next_line

end program test_jacobi_2

max_stars_repo_name: matt-frey/epic

max_issues_repo_name: matt-frey/epic

max_forks_repo_name: matt-frey/epic


text:
C
C**************************  RECHARGE **********************************
C
C  calculates water table recharge in terms of both flux and volume
C
C***********************************************************************
C
      SUBROUTINE RECHARGE(NNOD,NSTR,WNOD,ARENOD,PSI,TIME,DELTAT,RECFLOW,
     1                    RECVOL,RECNOD)
C
      IMPLICIT  NONE
      INTEGER   I,J
      INTEGER   NNOD,NSTR
      REAL*8    TIME,DELTAT,ZERO
      REAL*8    RECFLOW,RECVOL
      REAL*8    WNOD(*),ARENOD(*),PSI(*)
      REAL*8    RECNOD(*)
      PARAMETER (ZERO=0.0d0)
C
      RECFLOW = zero
      IF (TIME.EQ.0.0d0) THEN
         RECVOL = zero
      END IF
      CALL INIT0R(NNOD,RECNOD)
C
      DO I=NNOD*NSTR+1,NNOD*(NSTR+1)
         DO J=1,NSTR
            IF (PSI(I-(J-1)*NNOD).GT.ZERO.AND.PSI(I-J*NNOD).LE.ZERO)
     1      THEN
               IF (WNOD(I-J*NNOD).LE.ZERO) THEN
                  RECNOD(I-NNOD*NSTR)=-1.0d0*WNOD(I-J*NNOD)*
     1                                  ARENOD(I-NSTR*NNOD)
                  GO TO 100
               END IF
            END IF
         END DO
         IF (PSI(I-NNOD*NSTR).GE.0.0d0) THEN
            IF (WNOD(I-NNOD*NSTR).LE.ZERO) THEN
               RECNOD(I-NNOD*NSTR)=-1.0d0*WNOD(I-NSTR*NNOD)*
     1                              ARENOD(I-NSTR*NNOD)
            END IF
         END IF
 100     RECFLOW=RECFLOW+RECNOD(I-NNOD*NSTR)
      END DO
      RECVOL=RECVOL+RECFLOW*DELTAT
      return
      end


text:
! Check that parameters are correct intercepted.
! Constants with comma separations are commonly
! used, for instance Pi = 3._dp
subroutine foo(x)
  implicit none
  integer, parameter :: sp = selected_real_kind(6)
  integer, parameter :: dp = selected_real_kind(15)
  integer, parameter :: ii = selected_int_kind(9)
  integer, parameter :: il = selected_int_kind(18)
  real(dp), intent(inout) :: x
  dimension x(3)
  real(sp), parameter :: three_s = 3._sp
  real(dp), parameter :: three_d = 3._dp
  integer(ii), parameter :: three_i = 3_ii
  integer(il), parameter :: three_l = 3_il
  x(1) = x(1) + x(2) * three_s * three_i + x(3) * three_d * three_l
  x(2) = x(2) * three_s
  x(3) = x(3) * three_l
  return
end subroutine

subroutine foo_no(x)
  implicit none
  integer, parameter :: sp = selected_real_kind(6)
  integer, parameter :: dp = selected_real_kind(15)
  integer, parameter :: ii = selected_int_kind(9)
  integer, parameter :: il = selected_int_kind(18)
  real(dp), intent(inout) :: x
  dimension x(3)
  real(sp), parameter :: three_s = 3.
  real(dp), parameter :: three_d = 3.
  integer(ii), parameter :: three_i = 3
  integer(il), parameter :: three_l = 3
  x(1) = x(1) + x(2) * three_s * three_i + x(3) * three_d * three_l
  x(2) = x(2) * three_s
  x(3) = x(3) * three_l
  return
end subroutine

subroutine foo_sum(x)
  implicit none
  integer, parameter :: sp = selected_real_kind(6)
  integer, parameter :: dp = selected_real_kind(15)
  integer, parameter :: ii = selected_int_kind(9)
  integer, parameter :: il = selected_int_kind(18)
  real(dp), intent(inout) :: x
  dimension x(3)
  real(sp), parameter :: three_s = 2._sp + 1._sp
  real(dp), parameter :: three_d = 1._dp + 2._dp
  integer(ii), parameter :: three_i = 2_ii + 1_ii
  integer(il), parameter :: three_l = 1_il + 2_il
  x(1) = x(1) + x(2) * three_s * three_i + x(3) * three_d * three_l
  x(2) = x(2) * three_s
  x(3) = x(3) * three_l
  return
end subroutine

max_stars_repo_name: rocketbot-cl/recognition

max_issues_repo_name: rocketbot-cl/recognition

max_forks_repo_name: rocketbot-cl/recognition


text:
!-----------------------------------------------------------------------
!     Function:      jacobian_lsode
!     Authors:       S. Lazerson (lazerson@pppl.gov)
!     Date:          03/16/2012
!     Description:   This subroutine calculates the Jacobian of the ODE for
!                    field line following (LSODE).  Currently just a
!                    dummy routine.
!-----------------------------------------------------------------------
      SUBROUTINE jacobian_lsode(neq,phi,q,ml,mp,pd,nrpd)
!-----------------------------------------------------------------------
!     Libraries
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!     Input Variables
!          phi        phi angle
!          q          (q(1),q(2)) = (R,Z)
!          qdot       dq/dt
!-----------------------------------------------------------------------
      IMPLICIT NONE
      INTEGER          :: neq, nrpd, ml, mp
      DOUBLE PRECISION :: phi, q(2), pd(2,2)
!-----------------------------------------------------------------------
!     Local Variables
!          ierr        Error flag
!-----------------------------------------------------------------------
      INTEGER :: ier
!-----------------------------------------------------------------------
!     Begin Subroutine
!-----------------------------------------------------------------------
      ier    = 0
      pd = 0.0
      RETURN
!-----------------------------------------------------------------------
!     End Subroutine
!-----------------------------------------------------------------------
      END SUBROUTINE jacobian_lsode

max_stars_repo_name: joseluisvelasco/STELLOPT

max_issues_repo_name: joseluisvelasco/STELLOPT

max_forks_repo_name: joseluisvelasco/STELLOPT


text:
      integer function first_nonblank(str)

      implicit none

      character, intent(in) ::
     &     str*(*)

      integer ::
     &     ipos, len

      ipos = 1
      len = len_trim(str)

      do while(ipos.le.len)
        if (str(ipos:ipos).ne.' ') exit
        ipos = ipos+1
      end do

      if (ipos.gt.len) ipos = 0

      first_nonblank = ipos

      return
      end

max_stars_repo_name: ak-ustutt/GeCCo-public

max_issues_repo_name: ak-ustutt/GeCCo-public

max_forks_repo_name: ak-ustutt/GeCCo-public


text:
!
!     CalculiX - A 3-dimensional finite element program
!              Copyright (C) 1998-2015 Guido Dhondt
!
!     This program is free software; you can redistribute it and/or
!     modify it under the terms of the GNU General Public License as
!     published by the Free Software Foundation(version 2);
!
!
!     This program is distributed in the hope that it will be useful,
!     but WITHOUT ANY WARRANTY; without even the implied warranty of
!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
!     GNU General Public License for more details.
!
!     You should have received a copy of the GNU General Public License
!     along with this program; if not, write to the Free Software
!     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
      subroutine calceigenvalues(c,al)
!
!     calculates the eigenvalues al of the symmetric 3x3 matrix c
!     the eigenvalues are sorted in increasing order
!
      implicit none
!
      integer idummy(3),three,kflag,i
!
      real*8 c(3,3),al(3),v1,v2,v3,bb,cc,cm,cn,tt,pi
!
      data kflag /1/
      data three /3/
!
!     calculation of the eigenvalues of c
!     Simo & Hughes Computational Inelasticity p 244
!
      pi=4.d0*datan(1.d0)
!
      v1=c(1,1)+c(2,2)+c(3,3)
      v2=c(2,2)*c(3,3)+c(1,1)*c(3,3)+c(1,1)*c(2,2)-
     &     (c(2,3)*c(2,3)+c(1,3)*c(1,3)+c(1,2)*c(1,2))
      v3=c(1,1)*(c(2,2)*c(3,3)-c(2,3)*c(2,3))
     &     -c(1,2)*(c(1,2)*c(3,3)-c(1,3)*c(2,3))
     &     +c(1,3)*(c(1,2)*c(2,3)-c(1,3)*c(2,2))
!
      bb=v2-v1*v1/3.d0
      cc=-2.d0*v1**3/27.d0+v1*v2/3.d0-v3
      if(dabs(bb).le.1.d-10) then
         if(dabs(cc).gt.1.d-10) then
            al(1)=-cc**(1.d0/3.d0)
         else
            al(1)=0.d0
         endif
         al(2)=al(1)
         al(3)=al(1)
      else
         cm=2.d0*dsqrt(-bb/3.d0)
         cn=3.d0*cc/(cm*bb)
         if(dabs(cn).gt.1.d0) then
            if(cn.gt.1.d0) then
               cn=1.d0
            else
               cn=-1.d0
            endif
         endif
         tt=datan2(dsqrt(1.d0-cn*cn),cn)/3.d0
         al(1)=cm*dcos(tt)
         al(2)=cm*dcos(tt+2.d0*pi/3.d0)
         al(3)=cm*dcos(tt+4.d0*pi/3.d0)
      endif
      do i=1,3
         al(i)=al(i)+v1/3.d0
      enddo
!
!     sorting
!
      call dsort(al,idummy,three,kflag)
!
      return
      end

max_stars_repo_name: alleindrach/calculix-desktop

max_issues_repo_name: alleindrach/calculix-desktop

max_forks_repo_name: alleindrach/calculix-desktop


!------------------------------------------------------------------------------
!
! `temp` Source File
!
! temp.f90 source function file. This file contains subroutines for calculating
! temperatures in the system, as well as subroutines for controlling the
! temperature using thermostats applied to various locations. Also contains
! the subroutine responsible for relocating and freezing atoms that were
! sputtered from the target.
!
!------------------------------------------------------------------------------

MODULE temp

  USE prms
  USE data
  USE tools
  USE stats
  USE parallel
  USE par

  IMPLICIT none

  integer   ::  Ntemp1,Ntemp2,NtempTot1,NtempTot2
  integer,allocatable,dimension(:)   ::  T1list,T2list

CONTAINS

!function for applying a berendsen thermostat to atoms along the side of the domain
! X,V are position,velocity and Ttar is target temperature
  SUBROUTINE controlsidetemp (X,V, Ttar)
    real, dimension(Natm,3)     :: X,V
    real                        :: tempside, tempside_l, s, Ttar, nm
    integer                     :: kk_l, ierr, kk, i, ii
    integer, dimension(Nl)      :: tempside_list

    tempside_list = 0
    kk_l = 0
    tempside_l = 0.0
    tempside = 0.0
    nm = 1.0e-9
    do ii=1,Nl
        i = il(ii)
        if(   ((X(i,1).lt.sidewidth*nm) .or. (X(i,1).gt.(Lb(1)-sidewidth*nm)))  &
        .or. ((X(i,2).lt.sidewidth*nm) .or. (X(i,2).gt.(Lb(2)-sidewidth*nm)))  &
        .and.  ((X(i,3).lt.outz(1)*Lb(3)/10.0) .or. (X(i,3).gt.outz(4)*Lb(3)/10.0))) then
          if( atype(i) < 3 ) then
              tempside_l = tempside_l + mass(i)*(V(i,1)**2   + V(i,2)**2   + V(i,3)**2  )
              kk_l = kk_l+1
              tempside_list(kk_l) = i
          end if
        end if
    end do

    if(kk_l .gt. 0) then
        tempside_l = tempside_l/3./REAL(kk_l)/kB

        s = SQRT(1. + Ts/Tau*(Ttar/tempside_l-1.))

        do ii = 1,kk_l
            i = tempside_list(ii)
            V(i,:) = s*V(i,:)
        end do
    end if

  END SUBROUTINE controlsidetemp

!function for counting sputtered atoms, currently unused
  SUBROUTINE cntsputter(X,lt,impact)

    real, dimension(Natm,3)     :: X
    integer                     :: i,ii,ierr,lt,impact, sputtercnt, sputtercnt_l
    real                        :: buffer

    sputtercnt_l = 0
    sputtercnt = 0
    buffer = 0.7

    do ii=1,Nl
        i = il(ii)
        if(X(i,3) .gt. ((atomz(1)-buffer)*Lb(3)/10.0) .and. X(i,3) .lt. ((atomz(1)+buffer)*Lb(3)/10.0) .and. atype(i).lt.3) then
            sputtercnt_l = sputtercnt_l + 1
        end if
    end do
    call MPI_REDUCE(sputtercnt_l,sputtercnt,1,MPI_INTEGER,MPI_SUM, 0, MPI_COMM_WORLD, ierr)

    if(myid .eq. 0) then
        open(91, file='sputtercnt.dat', POSITION='APPEND')
        write(91,"(2I9)") impact, sputtercnt
        close(91)
    end if

  END SUBROUTINE CNTSPUTTER

!function for freezing and relocating atoms that have just been sputtered,
!and refreezing atoms that are currently in the sputter containment layers
  SUBROUTINE frzsptrdatms (X,V,F)
    real, dimension(Natm,3)     :: X,V,F
    integer                     :: i,ii,ierr
    real                        :: buffer

    buffer = 0.3
    do ii=1,Nl
        i = il(ii)
        if(   ((X(i,3).gt.outz(1)*Lb(3)/10.0) .and. (X(i,3).lt.outz(2)*Lb(3)/10.0))   ) then
            X(i,3) = atomz(1)*Lb(3)/10.0
            V(i,:) = 0.0
            F(i,:) = 0.0
        elseif (  ((X(i,3).gt.outz(3)*Lb(3)/10.0) .and. (X(i,3).lt.outz(4)*Lb(3)/10.0))    ) then
            X(i,3) = atomz(2)*Lb(3)/10.0
            V(i,:) = 0.0
            F(i,:) = 0.0
        elseif( ((X(i,3).gt.(atomz(1)-buffer)*Lb(3)/10.0) .and. (X(i,3).lt.(atomz(1)+buffer)*Lb(3)/10.0))  ) then
            V(i,:) = 0.0
            F(i,:) = 0.0
        elseif( ((X(i,3).gt.(atomz(2)-buffer)*Lb(3)/10.0) .and. (X(i,3).lt.(atomz(2)+buffer)*Lb(3)/10.0))  ) then
            V(i,:) = 0.0
            F(i,:) = 0.0
        elseif( ((X(i,3).gt.(ionz-buffer)*Lb(3)/10.0) .and. (X(i,3).lt.(ionz+buffer)*Lb(3)/10.0))  ) then
            V(i,:) = 0.0
            F(i,:) = 0.0
        end if
    end do

  END SUBROUTINE frzsptrdatms

!adjust temperature according to andersen thermostat, currently unused / untested
  SUBROUTINE adjusttempAnd(V,Ntemp,Tlist,Temp,Ttar)
    real, dimension(Natm,3)  :: V
    integer                  :: Ntemp
    integer,dimension(Ntemp) :: Tlist
    real                     :: Temp
    real                     :: Ttar
    real                     :: s
    integer                  :: i,ii
    integer                  :: l
    real, dimension(3)       :: Vb
    real                     :: ran1
    real   :: PE,Bltz

    do i = 1,Ntemp
       if (ran1(ranseed).lt.nu) then
          ii = Tlist(i)
          do l = 1,3
             do
                Vb(l) = -Vmax + 2.*Vmax*ran1(ranseed)
                Bltz =EXP(-mass(ii)*Vb(l)*Vb(l)/(2.*kB*Ttar))
                if (ran1(ranseed).lt.Bltz) exit
             end do
          end do
          V(ii,:) = Vb
       end if
    end do
  END SUBROUTINE adjusttempAnd

!function for berendsen thermostat to entire domain, for initialization
  SUBROUTINE adjusttemp(V,Temp,Ttar)
    real, dimension(Natm,3)  :: V

    real                     :: Temp
    real                     :: Ttar

    real                     :: s

    integer                  :: i,ii

    s = SQRT(1. + Ts/Tau*(Ttar/Temp-1.))

    !print *,myid,": ",Ttar,Temp,s
    !if (myid .eq. 0) print*,s, Temp
    do ii = 1,Nl
        i = il(ii)
        if(atype(i).lt.3)  V(i,:) = s*V(i,:)
    end do

  END SUBROUTINE adjusttemp

!  Compute the mean temperature for the system, not including Ga ions
  SUBROUTINE temperature(V,Temp)
    real, dimension(Natm,3)  :: V
    real                     :: Temp,Temp_l
    integer                  :: i,ii
    integer                  :: ierr

!                       3
!       3/2 kB T   =   SUM ( 1/2 m v_i^2 )
!                      i=1

    Temp_l = 0.
    do ii = 1,Nl
        i = il(ii)
        if(atype(i).lt.3) then
            Temp_l = Temp_l + mass(i)*(V(i,1)**2   + V(i,2)**2   + V(i,3)**2  )
        end if
    end do
    Temp_l = Temp_l/3./REAL(Nsg)/kB
    !Temp_l = Temp_l/3./REAL(Nl)/kB  !Kallol

    call MPI_ALLREDUCE(Temp_l, Temp, 1, MPI_REAL8, MPI_SUM, MPI_COMM_WORLD, ierr)

  END SUBROUTINE temperature

END MODULE temp


text:
C************************************************************************
C  This test routine is used to test CYLPATCH, a FORTRAN subroutine.
C  CLYPATCH  computes the special line and sample point and special
C  latitude and longitude points for the normal cylindrical projection.
C  This test routine builds the necessary data in a standard MAP
C  buffer.  After testing the subroutine using this FORTRAN driver, a
C  "C" version is invoked "tzcylpatch".  tzcylpatch uses a bridge
C  "zcylpatch" to invoke CYLPATCH.  The test cases are the same, only
C  in "C".
C************************************************************************
C  RDATA is a real*4 40 element array as described in CONVEV.
C   rdata(1) - sample
C   rdata(2) - line
C   rdata(3) - Latitude
C   rdata(6) - Longitude
C   rdata(7) - scale (km/pixel)
C   rdata(39) - projection type = 9
C   rdata(25) - polar radius (km)
C   rdata(26) - equatorial radius (km)
C  Some values will be changed after execution of CYLPATCH.
C   rdata(1) - special sample point
C   rdata(2) - special line point
C   rdata(3) - Latitude at sample 1
C   rdata(6) - Longitude (west) at sample 1
C  If rdata(39) is not equal to 9 (integer), then data is not for a
C  cylindrical projection. CYLPATCH returns without making any changes.
C************************************************************************

      include 'VICMAIN_FOR'
      subroutine main44
      implicit none
      real rdata(40)
      integer idata(40),j
      character*80 msg
      equivalence(idata(1),rdata(1))
      idata(39)=9
      rdata(1)=1.
      rdata(2)=1.
      rdata(3)=85.7461
      rdata(6)=239.916
      rdata(7)=10.
      rdata(25)=1815.
      rdata(26)=1815.
      call xvmessage
     +     ('at line=1. sample=1. lati=85.7461 long=239.916',' ')
      call xvmessage('radius=1815., scal=10',' ')
      write(msg,40)(RDATA(j),j=25,26)
      call xvmessage(msg,' ')
      write(msg,50)(RDATA(j),j=1,5)
      call xvmessage(msg,' ')
      write(msg,51)(RDATA(j),j=6,10)
      call xvmessage(msg,' ')
      call xvmessage(' ',' ')
      call cylpatch(rdata)
      call xvmessage('output should be lati=0 at line=182, samp=761 long
     *=239.916',' ')
      write(msg,41) RDATA(1)
      call xvmessage(msg,' ')
      write(msg,42) RDATA(2)
      call xvmessage(msg,' ')
      write(msg,43) RDATA(3)
      call xvmessage(msg,' ')
      write(msg,44) RDATA(6)
      call xvmessage(msg,' ')
      write(msg,52)(RDATA(j),j=1,5)
      call xvmessage(msg,' ')
      write(msg,51)(RDATA(j),j=6,10)
      call xvmessage(msg,' ')
      call xvmessage(' ',' ')
      rdata(1)=100.
      rdata(2)=100.
      rdata(3)=26.8586
      rdata(6)=208.6638
      call xvmessage
     +    ('at line=100,samp=100,lati=26.8586,long=208.6638',' ')
      write(msg,50)(RDATA(j),j=1,5)
      call xvmessage(msg,' ')
      write(msg,51)(RDATA(j),j=6,10)
      call xvmessage(msg,' ')
      call xvmessage(' ',' ')
      call cylpatch(rdata)
      call xvmessage('output should be lati=0 at line=182, samp=761 long
     *=239.916', ' ')
      write(msg,41) RDATA(1)
      call xvmessage(msg,' ')
      write(msg,42) RDATA(2)
      call xvmessage(msg,' ')
      write(msg,43) RDATA(3)
      call xvmessage(msg,' ')
      write(msg,44) RDATA(6)
      call xvmessage(msg,' ')
      write(msg,52)(RDATA(j),j=1,5)
      call xvmessage(msg,' ')
      write(msg,51)(RDATA(j),j=6,10)
      call xvmessage(msg,' ')
      call xvmessage(' ',' ')
      call xvmessage('NOW TRY "C" INTERFACE',' ')
      call tzcylpatch
40    format ('RADII=',2f10.4)
41    format ('sample=',f12.5)
42    format ('line=  ',f12.5)
43    format ('lati=  ',f12.5)
44    format ('long=  ',f12.5)
50    format ('input  data=',5f12.7)
51    format ('            ',5f12.7)
52    format ('output data=',5f12.7)
      return
      end

max_stars_repo_name: NASA-AMMOS/VICAR

max_issues_repo_name: NASA-AMMOS/VICAR

max_forks_repo_name: NASA-AMMOS/VICAR


text:
! { dg-do compile }
! { dg-options "-std=f2003" }
!
! Check for new F2008 integer constants, needed for
! coarray support (cf. PR fortran/18918)
!

USE iso_fortran_env
implicit none
integer(kind=ATOMIC_INT_KIND) :: atomic_int ! { dg-error "has no IMPLICIT type" }
logical(kind=ATOMIC_LOGICAL_KIND) :: atomic_bool ! { dg-error "has no IMPLICIT type" }

print *, OUTPUT_UNIT

if (IOSTAT_INQUIRE_INTERNAL_UNIT <= 0) call abort() ! { dg-error "has no IMPLICIT type" }
print *,STAT_STOPPED_IMAGE ! { dg-error "has no IMPLICIT type" }
print *, STAT_LOCKED_OTHER_IMAGE ! { dg-error "has no IMPLICIT type" }
print *, STAT_LOCKED ! { dg-error "has no IMPLICIT type" }
print *, STAT_UNLOCKED ! { dg-error "has no IMPLICIT type" }
end

module m
USE iso_fortran_env, only: INPUT_UNIT
USE iso_fortran_env, only: ATOMIC_INT_KIND ! { dg-error "is not in the selected standard" }
implicit none
end module m

module m2
USE iso_fortran_env, only: foo => STAT_UNLOCKED ! { dg-error "is not in the selected standard" }
implicit none
end module m2

module m3
USE iso_fortran_env, foo => IOSTAT_INQUIRE_INTERNAL_UNIT ! { dg-error "not in the selected standard" }
implicit none
end module m3

max_stars_repo_name: maurizioabba/rose

max_issues_repo_name: sujankh/rose-matlab

max_forks_repo_name: sujankh/rose-matlab


text:
Mariko Yamada represents most of Yolo and Solano Counties in the California State Assembly.  She previously served on the Yolo County Board of Supervisors. Yamada is known as a leader on social service issues, especially those for the poor, elderly, and disabled.

Yamada also spent a decade in Washington, D.C. first with the U.S. Census Bureau 1980 Census undercount reduction campaign and then as an investigator with the Office of the Secretary, Office for Civil Rights, U.S. Department of Commerce.  She was spotted at a rally in support of Sodexho workers efforts to unionize.

Working Families for Progressive Leadership mailed literature commenting on her opponent during the 2008 City Council Election Spring 2008 Election.

 Campaign Literature

Paid for by Working Families for Progressive Leadership

Paid for by Working Families for Progressive Leadership

Paid for by Working Families for Progressive Leadership

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


text:
// Generated Files
${PROJ_DIR}/axi4-st/axi_st_d256_gen1_gen2/axi_st_d256_gen1_gen2_slave_top.sv
${PROJ_DIR}/axi4-st/axi_st_d256_gen1_gen2/axi_st_d256_gen1_gen2_slave_concat.sv
${PROJ_DIR}/axi4-st/axi_st_d256_gen1_gen2/axi_st_d256_gen1_gen2_slave_name.sv

// Logic Link files
-f ${PROJ_DIR}/llink/rtl/llink.f

// Common Files
-f ${PROJ_DIR}/common/rtl/common.f

max_stars_repo_name: chipsalliance/aib-protocols

max_issues_repo_name: chipsalliance/aib-protocols

max_forks_repo_name: chipsalliance/aib-protocols


text:
      FUNCTION EFAC3(ZETA,ICASE)
*
*
*       Tidal capture efficiency factor (l = 3).
*       ----------------------------------------
*
*       Fitting functions for the third spherical harmonic index based on
*       Ray et. al. (A & A 184, 164) and Lee & Ostriker (Ap. J. 310, 176).
*       Developed at IOA by S. Portegies Zwart & T. Meinen (A & A 280, 174).
*
      REAL*8  ZETA,COEFF(6),EFAC3
*
*
*       Select coefficients for a given polytropic index (ICASE = 1, 2, 3).
      IF (ICASE.EQ.1) THEN
*       Polytropic index 1.5.
          COEFF(1) = -0.909
          COEFF(2) =  1.574
          COEFF(3) = 12.37
          COEFF(4) =-57.40
          COEFF(5) = 80.10
          COEFF(6) =-46.43
      ELSE
          IF (ICASE.EQ.2) THEN
*       Polytropic index 2.
              COEFF(1) = -1.040
              COEFF(2) = -1.354
              COEFF(3) = 37.64
              COEFF(4) =-139.9
              COEFF(5) = 168.2
              COEFF(6) = -66.53
          ELSE
*       Polytropic index 3.
              COEFF(1) = -1.703
              COEFF(2) = 2.653
              COEFF(3) =-14.34
              COEFF(4) = 12.85
              COEFF(5) = -0.492
              COEFF(6) = -3.600
          END IF
      END IF
*
*       Obtain the tidal energy factor from fourth-order polynomial fit.
      Y = LOG10(ZETA)
      EFAC3 = ((((COEFF(6)*Y + COEFF(5))*Y + COEFF(4))*Y + COEFF(3))*Y
     &                                     + COEFF(2))*Y + COEFF(1)
      EFAC3 = 10.0**EFAC3
*
      RETURN
*
      END

max_stars_repo_name: rknop/amuse

max_issues_repo_name: rknop/amuse

max_forks_repo_name: rieder/amuse


text:
! This is part of the netCDF F90 API, or. Copyright 2006 UCAR. See COPYRIGHT file
! for details.

! This file contains the netcdf-3 file open and create functions.

! $Id: netcdf4_constants.f90,v 1.14 2010/05/25 13:53:00 ed Exp $
! -------
function nf90_open(path, mode, ncid, chunksize)
  character (len = *), intent(in   ) :: path
  integer,             intent(in   ) :: mode
  integer,             intent(  out) :: ncid
  integer, optional,   intent(inout) :: chunksize
  integer                            :: nf90_open

  if(present(chunksize)) then
     nf90_open = nf__open(path, mode, chunksize, ncid)
  else
     nf90_open = nf_open(path, mode, ncid)
  end if
end function nf90_open
! -------
function nf90_create(path, cmode, ncid, initialsize, chunksize)
  character (len = *), intent(in   ) :: path
  integer,             intent(in   ) :: cmode
  integer,             intent(  out) :: ncid
  integer, optional,   intent(in   ) :: initialsize
  integer, optional,   intent(inout) :: chunksize
  integer                            :: nf90_create

  integer :: fileSize, chunk

  if(.not. (present(initialsize) .or. present(chunksize)) ) then
     nf90_create = nf_create(path, cmode, ncid)
  else
     ! Default values per man page
     filesize = 0; chunk = nf90_sizehint_default
     if(present(initialsize)) filesize = initialsize
     if(present(chunksize  )) chunk    = chunksize
     nf90_create = nf__create(path, cmode, filesize, chunk, ncid)
     ! Pass back the value actually used
     if(present(chunksize  )) chunksize = chunk
  end if
end function nf90_create

max_stars_repo_licenses: FTL zlib-acknowledgement RSA-MD

max_issues_repo_licenses: FTL zlib-acknowledgement RSA-MD

max_forks_repo_licenses: FTL zlib-acknowledgement RSA-MD