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=======================================================================
      PROGRAM GENSHL
C=======================================================================
C     --*** GENSHL *** (GENSHL) GENESIS 2D to 3D Shell Program
C     --
C     --GENSHL inputs a 2D GENESIS database and outputs a 3D GENESIS database.
C     --
C     --Expected input:
C     --   o The commands on the standard input device.
C     --   o The 2D GENESIS database on unit 9
C     --     (must have 4 nodes per element,
C     --     cannot have more than 2048 element blocks).
C     --
C     --Output:
C     --   o A listing of the input database information and any errors
C     --     found on the standard output device.
C     --   o The 3D GENESIS Shell database on unit 10.

C     --Developed at Sandia National Laboratories.
C     --
C     --Current author and code sponsor: Gregory D. Sjaardema
C     --
C     --Revision History:
C     --   04/86 GEN3D Created (Amy Gilkey)
C     --   01/91 GENSHL Created (Greg Sjaardema)
C     --
C     --Source is in FORTRAN 77
C     --
C     --External software used:
C     --   SUPES package (dynamic memory, free-field reader, FORTRAN extensions)
C     --   SUPLIB package (EXODUS file manipulation and other routines)
C     --

C     --Documentation:
C     --   --NONE--

      include 'exodusII.inc'
      INCLUDE 'gs_progqa.blk'
      INCLUDE 'gs_dbase.blk'
      INCLUDE 'gs_dbtitl.blk'
      INCLUDE 'gs_dbnums.blk'
      INCLUDE 'gs_dbnum3.blk'
      INCLUDE 'gs_params.blk'
      INCLUDE 'gs_xyzoff.blk'
      INCLUDE 'gs_xyzrot.blk'
      INCLUDE 'gs_xyzmir.blk'
      INCLUDE 'argparse.inc'

      CHARACTER*2048 FILIN, FILOUT, SCRATCH

      CHARACTER*(MXSTLN) NAMECO(6)
      CHARACTER*(MXSTLN) NAMELB(2048)
C     --NAMECO - the coordinate names
C     --NAMELB - the element block names

      CHARACTER CDUM

      DIMENSION A(1)
      INTEGER IA(1)
      EQUIVALENCE (A(1), IA(1))
      CHARACTER*1 C(1)
C     --A - the dynamic numeric memory base array

      INTEGER IDNSET(0:10,2)
      INTEGER IDESET(0:10,2)

      INCLUDE 'gs_qainfo.blk'

      CALL STRTUP (QAINFO)

      CALL BANNER (0, QAINFO,
     &     'A GENESIS DATABASE 2D TO 3D SHELL CONVERSION PROGRAM',
     &     ' ', ' ')
      call cpyrgt (0, '1991')

      CALL MDINIT (A)
      CALL MCINIT (C)
      CALL MDSTAT (NERR, MEM)
      IF (NERR .GT. 0) GOTO 40

C .. Get filename from command line.  If not specified, emit error message
      NARG = argument_count()
      if (narg .lt. 2) then
        CALL PRTERR ('FATAL', 'Filenames not specified.')
        CALL PRTERR ('FATAL',
     *    'Syntax is: "genshell 2dfilename 3dfilename"')
        GOTO 60
      else if (narg .gt. 2) then
        CALL PRTERR ('FATAL', 'Too many arguments specified.')
        CALL PRTERR ('FATAL',
     *    'Syntax is: "genshell 2dfilename 3dfilename"')
        GOTO 60
      end if

C     --Open the input database and read the initial variables

      NDBIN  = 9
      NDBOUT = 10

      CMPSIZ = 0
      IOWS   = 0

      FILIN = ' '
      CALL get_argument(1,FILIN, LNAM)
      NDBIN = exopen(filin(:lnam), EXREAD, CMPSIZ, IOWS, vers, IERR)
      IF (IERR .NE. 0) THEN
        SCRATCH = 'Database "'//FILIN(:LNAM)//'" does not exist.'
        CALL PRTERR ('FATAL', SCRATCH(:LENSTR(SCRATCH)))
        GOTO 60
      END IF

      call exgini(ndbin, title, ndim, numnp, numel, nelblk,
     *     numnps, numess, ierr)
      if (nelblk .gt. 2048) then
        CALL PRTERR ('PROGRAM', 'Too many element blocks. 2048 MAX')
         GOTO 60
      end if
      if (numnps .gt. 0) then
         call exinq(ndbin, EXNSNL, lnpsnl, rdum, cdum, ierr)
         call exinq(ndbin, EXNSDF, lnpsdf, rdum, cdum, ierr)
      else
         lnpsnl = 0
         lnpsdf = 0
      end if
      if (numess .gt. 0) then
         call exinq(ndbin, EXSSNL, lessnl, rdum, cdum, ierr)
         call exinq(ndbin, EXSSEL, lessel, rdum, cdum, ierr)
         call exinq(ndbin, EXSSDF, lessdf, rdum, cdum, ierr)
      else
         lessnl = 0
         lessel = 0
         lessdf = 0
      end if

      CALL DBPINI ('NTIS', NDBIN, TITLE, NDIM, NUMNP, NUMEL, NELBLK,
     &     NUMNPS, LNPSNL, LNPSDF, NUMESS, LESSEL, LESSNL,
     &     LESSDF, IDUM, IDUM, IDUM)

      IF (NDIM .NE. 2) THEN
         CALL PRTERR ('FATAL', 'Number of dimensions must be 2')
         GOTO 60
      END IF

C     --Reserve memory for the 2D information

      CALL MDRSRV ('XN', KXN, NUMNP)
      CALL MDRSRV ('YN', KYN, NUMNP)
      KZN = 1

      CALL MDRSRV ('MAPEL', KMAPEL, NUMEL)

      CALL MDRSRV ('IDELB', KIDELB, NELBLK)
      CALL MDRSRV ('NUMELB', KNELB, NELBLK)
      CALL MDRSRV ('NUMLNK', KNLNK, NELBLK)
      CALL MDRSRV ('NUMATR', KNATR, NELBLK)
      CALL MDRSRV ('LINK', KLINK, 0)
      CALL MDRSRV ('ATRIB', KATRIB, 0)

      CALL MDRSRV ('IDNPS',  KIDNS, NUMNPS)
      CALL MDRSRV ('NNNPS',  KNNNS, NUMNPS)
      CALL MDRSRV ('NDNPS',  KNDNPS, NUMNPS)
      CALL MDRSRV ('IXNNPS', KIXNNS, NUMNPS)
      CALL MDRSRV ('IXDNPS', KIXDNS, NUMNPS)
      CALL MDRSRV ('LTNNPS', KLTNNS, LNPSNL)
      CALL MDRSRV ('FACNPS', KFACNS, LNPSNL)

      CALL MDRSRV ('IDESS',  KIDSS, NUMESS)
      CALL MDRSRV ('NEESS',  KNESS, NUMESS)
      CALL MDRSRV ('NNESS',  KNNSS, NUMESS)
      CALL MDRSRV ('NDESS',  KNDSS,  NUMESS)
      CALL MDRSRV ('IXEESS', KIXESS, NUMESS)
      CALL MDRSRV ('IXNESS', KIXNSS, NUMESS)
      CALL MDRSRV ('IXDESS', KIXDSS, NUMESS)
      CALL MDRSRV ('LTNNSS', KLTNNN, LESSEL)
      CALL MDRSRV ('LTEESS', KLTESS, LESSEL)
      CALL MDRSRV ('LTNESS', KLTNSS, LESSNL)
      CALL MDRSRV ('LTSESS', KLTSSS, LESSEL)
      CALL MDRSRV ('FACESS', KFACSS, LESSNL)

      CALL MDSTAT (NERR, MEM)
      IF (NERR .GT. 0) GOTO 40

C     --Read 2D information from the database and close file

      call exgcor (ndbin, a(kxn), a(kyn), a(kzn), ierr)
      call exgmap (ndbin, ia(kmapel), ierr)

      CALL INISTR (NDIM, ' ', NAMECO)
      call exgcon (ndbin, nameco, ierr)

      CALL INISTR (2048, ' ', NAMELB)
      CALL DBIELB (NDBIN, '*', 1, NELBLK,
     *  IA(KIDELB), IA(KNELB), IA(KNLNK), IA(KNATR),
     *  A, IA, KLINK, KATRIB, NAMELB, *60)
      CALL MDSTAT (NERR, MEM)
      IF (NERR .GT. 0) GOTO 40

C ... At the current time, only handle all 4-node or 8-node hexes per model.
      NLNK = IA(KNLNK)
      DO 5 IEL = 2, NELBLK
        if (NLNK .NE. IA(KNLNK+IEL-1)) THEN
          CALL PRTERR ('FATAL',
     *      'Mesh must be ALL 4-node or ALL 8-node quads')
          STOP
        END IF
 5    CONTINUE

      if (numnps .gt. 0) then
         call exgcns(ndbin, a(kidns), a(knnns), a(kndnps), a(kixnns),
     *        a(kixdns), a(kltnns), a(kfacns), ierr)
      end if

      if (numess .gt. 0) then
         call exgcss(ndbin, a(kidss), a(kness), a(kndss), a(kixess),
     *        a(kixdss), A(KLTeSS), a(kltsss), a(kfacss), ierr)
      end if

      call exinq(ndbin, EXQA,   nqarec, rdum, cdum, ierr)
      call exinq(ndbin, EXINFO, ninfo,  rdum, cdum, ierr)
      call mcrsrv('QAREC', kqarec, (nqarec+1) * 4 * MXSTLN)
      call mcrsrv('INFREC', kinfo, (ninfo+1) * MXLNLN)
      CALL MCSTAT (NERR, MEM)
      IF (NERR .GT. 0) GOTO 40
      if (nqarec .gt. 0) then
C     ... Wrapper to get strings the right length
         call exgqaw(ndbin, c(kqarec), ierr)
      end if
      if (ninfo .gt. 0) then
C     ... Wrapper to get info record the right length
         call exginw(ndbin, c(kinfo), ierr)
      end if

      IF ((NQAREC .GT. 0) .OR. (NINFO .GT. 0)) THEN
         CALL DBPQA ('*', NQAREC,  c(kqarec), NINFO, c(kinfo))
      END IF

C     -- This assumes only max of 7 attributes per element block
      CALL MDRSRV ('ATRIBNW', KATRIBN, 0)
      CALL MDRSRV ('ELATTR', KELATT, NELBLK*7)
      CALL MDSTAT (NERR, MEM)
      IF (NERR .GT. 0) GOTO 40

C     --Read in runtime parameters

      CALL COMAND (IA(KIDNS), IA(KIDSS), IDNSET, IDESET,
     &     IA(KIDELB), IA(KNELB), IA(KNLNK), NAMELB, A(KELATT),
     &     A(KXN), A(KYN), A, *60)

C     --Get the new numbers for the elements and nodes

      LNPSNO = LNPSNL

C     --Get the node sets

      CONTINUE

C     --Get the side sets, and the front and back side sets

      NSSET = IDESET(0,1)+IDESET(0,2)
      IF (NSSET .GT. 0) THEN
         CALL MDRSRV ('ISSFRO', KISFRO, NUMEL)
         CALL MDRSRV ('ISSBCK', KISBCK, NUMEL)
         CALL MDRSRV ('NSSFRO', KNSFRO, NLNK*NUMEL)
         CALL MDRSRV ('NSSBCK', KNSBCK, NLNK*NUMEL)
      ELSE
         KISFRO = 1
         KISBCK = 1
         KNSFRO = 1
         KNSBCK = 1
      END IF

      LESSEO = INTADD (NUMESS, IA(KNESS))
      LESSNO = INTADD (NUMESS, IA(KNDSS))

      CALL NEWESS
     &     (IDESET(0,1), IDESET(0,2), NSSUR, NLNK,
     &     IA(KLINK), IA(KISFRO), IA(KISBCK), IA(KNSFRO), IA(KNSBCK))

      IF (NSSET .GT. 0) THEN
         CALL MDLONG ('NSSFRO', KNSFRO, NSSUR)
         CALL MDLONG ('NSSBCK', KNSBCK, NSSUR)
      END IF
      CALL MDSTAT (NERR, MEM)
      IF (NERR .GT. 0) GOTO 40

C     --Open the output database
      FILOUT = ' '
      CALL get_argument(2,FILOUT, LFIL)
      CMPSIZ = 0
      IOWS   = iowdsz()
      ndbout = excre(filout(:lfil), EXCLOB, CMPSIZ, IOWS, IERR)
      if (ierr .lt. 0) then
         call exopts (EXVRBS, ierr)
         call exerr('grepos', 'Error from excre', ierr)
         go to 50
      endif

C     --Write the initial variables

      CALL NEWINI (IDNSET(0,1)+IDNSET(0,2), IDESET(0,1)+IDESET(0,2),
     &     NSSUR, IA(KNATR))
      call expini (ndbout, title, ndim3, numnp3, numel3, nelbl3,
     &     nnps3, ness3, ierr)

      CALL DBPINI ('NTIS', NDBOUT, TITLE, NDIM3, NUMNP3, NUMEL3, NELBL3,
     &  NNPS3, LNPSN3, LNPSN3, NESS3, LESSE3, LESSN3, LESSN3,
     &  IDUM, IDUM, IDUM)

C     --Write the coordinates

      CALL MDRSRV ('XN3', KXN3, NUMNP3)
      CALL MDRSRV ('YN3', KYN3, NUMNP3)
      CALL MDRSRV ('ZN3', KZN3, NUMNP3)

C     -- Since we only read quads, NUMATR should be 0.  For a shell, we
C     have 1 attribute (thickness)

      CALL MDLONG ('ATRIB', KATRIB, NUMEL3)

      CALL MDSTAT (NERR, MEM)
      IF (NERR .GT. 0) GOTO 40

      CALL NEWXYZ (A(KXN), A(KYN), A(KXN3), A(KYN3), A(KZN3),
     $     A(KATRIB), A )
      call expcor (ndbout, a(kxn3), a(kyn3), a(kzn3), ierr)

      NAMECO(1) = 'X'
      NAMECO(2) = 'Y'
      NAMECO(3) = 'Z'
      call expcon(ndbout, nameco, ierr)

      CALL MDDEL ('XN')
      CALL MDDEL ('YN')
      CALL MDDEL ('XN3')
      CALL MDDEL ('YN3')
      CALL MDDEL ('ZN3')
      CALL MDSTAT (NERR, MEM)
      IF (NERR .GT. 0) GOTO 40

C     --Write the element order map - NOTE: New map is same as old map
      call expmap (ndbout, ia(kmapel), ierr)
      CALL MDDEL ('MAPEL')

C     --Fixup connectivity if mirrored
      IF (XMIRR * YMIRR * ZMIRR .LT. 0.0) THEN
         CALL DBMIRR (1, NELBLK, IA(KIDELB), IA(KNELB),
     $        IA(KNLNK), IA(KLINK))
      END IF
C     --Write the element block

      ILOFF = 0
      IAOFF = 0
      DO 30 I = 1, NELBLK
C ... Calculate these here since values may change if BEAM...
        II = I - 1
        ILINC = IA(KNELB+II) * IA(KNLNK+II)
        IAINC = IA(KNELB+II) * IA(KNATR+II)
        IF (NAMELB(I)(:4) .EQ. 'QUAD' .OR. NAMELB(I) .EQ. ' ') THEN
          NAMELB(I) = 'SHELL'
        ELSE IF (NAMELB(I)(:4) .EQ. 'BEAM') THEN
          IA(KNATR+I-1) = 7
        ELSE
          CALL PRTERR ('CMDWARN',
     $      'Invalid Element Block Type')
        END IF
        CALL DBOELB (A, NDBOUT, IA(KIDELB+II), IA(KNELB+II),
     $    IA(KNLNK+II), IA(KNATR+II), IA(KLINK+ILOFF),
     *    NAMELB(I), A(KATRIB), A(KELATT+(II*7)))
        ILOFF = ILOFF + ILINC
        IAOFF = IAOFF + IAINC

 30   CONTINUE

      CALL MDDEL ('LINK')
      CALL MDDEL ('ATRIB')
      CALL MDSTAT (NERR, MEM)
      IF (NERR .GT. 0) GOTO 40

C     --Write the node sets

      CALL WRNPS (A, IA, IDNSET(0,1), IDNSET(0,2), IA(KIDNS),
     &  IA(KNNNS), IA(KIXNNS), IA(KLTNNS), A(KFACNS), *40)

C     --Fixup sides sets if mirrored
c$$$      IF (XMIRR * YMIRR * ZMIRR .LT. 0.0) THEN
c$$$         CALL MIRSS (IDESET(0,1), IDESET(0,2), NLNK,
c$$$     &        NSSUR, IA(KNSFRO), IA(KNSBCK), IA(KLTSSS))
c$$$      END IF
C     --Write the side sets

      CALL WRESS (A, IA, IDESET(0,1), IDESET(0,2),
     &     IA(KISFRO), IA(KISBCK), NSSUR, IA(KNSFRO), IA(KNSBCK),
     &     IA(KIDSS), IA(KNESS), IA(KNDSS), IA(KIXESS), IA(KIXDSS),
     &     IA(KLTESS), IA(KLTSSS), A(KFACSS), *40)

      IF (NSSET .GT. 0) THEN
         CALL MDDEL ('ISSFRO')
         CALL MDDEL ('ISSBCK')
         CALL MDDEL ('NSSFRO')
         CALL MDDEL ('NSSBCK')
      END IF
      CALL MDSTAT (NERR, MEM)
      IF (NERR .GT. 0) GOTO 40

C   --Write the QA records
      CALL DBOQA (NDBOUT, QAINFO, NQAREC, c(kqarec),
     &     NINFO, c(kinfo), ' GenShell: ', FILIN)

      GOTO 50

 40   CONTINUE
      CALL MEMERR
      GOTO 50

 50   CONTINUE
      call mdfree()
      call exclos(ndbin,  ierr)
      call exclos(ndbout, ierr)

 60   CONTINUE
      call addlog (QAINFO(1)(:lenstr(QAINFO(1))))
      CALL WRAPUP (QAINFO(1))

      END

      subroutine exgqaw(ndb, qarec, ierr)
      include 'exodusII.inc'
      character*(mxstln) qarec(4, *)
      call exgqa(ndb, qarec, ierr)
      return
      end

      subroutine exginw(ndb, info, ierr)
      include 'exodusII.inc'
      character*(mxlnln) info(*)
      call exginf(ndb, info, ierr)
      return
      end

max_stars_repo_name: jschueller/seacas

max_issues_repo_name: jschueller/seacas

max_forks_repo_name: jschueller/seacas


text:
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------

MODULE m_ifft
   use m_juDFT
CONTAINS
   INTEGER FUNCTION ifft235(ksfft, n, gmaxp)
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
!   this function checks wether n can be expressed as :
!   n =  (2**P) * (3**Q) * (5**R) to match withe the MFFT - routines
!   used in this program. If close to n there is a number n' which
!   is solely expressable as n'= 2**p then this number sis choosen
!   and is outputted by the function. If n is not expressable as
!   n =  (2**P) * (3**Q) * (5**R) a number n' is choosen close to ns
!   is selected which fullfilles these requirements.

!                            Stefan Bl"ugel , kfa, Oct. 1993
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
      IMPLICIT NONE

!----> declaration part

      INTEGER :: ksfft, n
      REAL ::    gmaxp

!----> local variabels

      INTEGER :: np, nn, nl, iexp, is, itrial
      REAL :: rl
      REAL :: fac_1, two, fac_2, fac_3, one, fac_4
      PARAMETER(two=2.0e0, fac_1=1.001e0, fac_2=1.7e0, fac_3=1.95e0)
      PARAMETER(one=1.0e0, fac_4=0.03e0)
      INTRINSIC abs, log, mod, real

      ifft235 = 0
      IF (n == 0) THEN
         CALL juDFT_error("n should not be zero", calledby="ifft235")
      ENDIF

!====> RADIX 2 CALCULATION ONLY

      IF (ksfft == 0) THEN
         rl = log(real(n))/log(two)
         nl = rl
         IF (abs(n - 2**nl) > abs(n - 2**(nl + 1))) THEN
            np = nl + 1
         ELSE
            np = nl
         ENDIF
         IF ((np == nl) .AND. (gmaxp*real(nl)/rl < fac_1)) &
            np = nl + 1
         ifft235 = 2**np
         RETURN
      ENDIF

!====> RADIX 2 , 3, 5 CALCULATION

!----> since gmaxp is large enough, try also smaller n

      IF (gmaxp > fac_2 .AND. gmaxp < fac_3) THEN
         is = -1
      ELSE
         is = 1
      ENDIF
      np = n
      nn = n

      DO itrial = 1, 200

         !----> check whether there is a number close by, which is 2**NL
         !      ( FFT very fast )

         rl = log(real(nn))/log(two)
         nl = rl
         IF ((abs(real(nl)/rl - one) < fac_4) .AND. &
             (2**nl >= n)) THEN
            IF (gmaxp*real(nl)/rl > one) ifft235 = 2**nl
            RETURN
         ELSE IF ((abs(real(nl + 1)/rl - one) < fac_4) .AND. &
                  (2**(nl + 1) >= n)) THEN
            ifft235 = 2**(nl + 1)
            RETURN
         ELSE

            !----> no , no binary number is arround, check wether number can be
            !      divided by 2,3 or 5

            DO iexp = 1, nl + 1
               IF (mod(nn, 2) == 0) THEN
                  nn = nn/2
               ELSE IF (mod(nn, 3) == 0) THEN
                  nn = nn/3
               ELSE IF (mod(nn, 5) == 0) THEN
                  nn = nn/5
               ENDIF
               IF (nn == 2 .OR. nn == 3 .OR. nn == 5) THEN
                  !---> o.k.
                  ifft235 = np
                  RETURN
               ENDIF
            ENDDO

            !----> no , n  cannot be expressed as (2**P) * (3**Q) * (5**R)
            !      change number
            nn = n + (is**(itrial))*((itrial + 1)/2)
            np = n + (is**(itrial))*((itrial + 1)/2)
         ENDIF
      ENDDO

      call juDFT_error(' to few trials '//int2str(itrial))

   END FUNCTION ifft235
!-----------------------------------------------------------------------
   INTEGER FUNCTION i2357(ii)

! simple setup to determine fft-length for ESSL calls

      IMPLICIT NONE
      INTEGER, INTENT(IN)  :: ii
      INTEGER :: i, j, k, h, m, n, nn

      nn = 12582912
      DO m = 0, 1
         DO k = 0, 1
            DO j = 0, 1
               DO i = 0, 1
                  DO h = 1, 25
                     n = 2**h*3**i*5**j*7**k*11**m
                     IF ((n > ii) .AND. (n < nn)) nn = n
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      i2357 = nn

   END FUNCTION i2357

END MODULE m_ifft

max_stars_repo_name: MRedies/FLEUR

max_issues_repo_name: MRedies/FLEUR

max_forks_repo_name: MRedies/FLEUR


text:
  interface
    subroutine trend_init_no_char(nc,int_path,npath,int_comps,ncomps,mix,Rgas)
      implicit none
      integer, intent(in) :: nc
      integer, intent(in) :: mix
      integer, intent(in) :: npath
      integer, intent(in) :: ncomps
      integer, intent(in) :: int_path(npath)
      integer, intent(in) :: int_comps(ncomps)
      real,    intent(in) :: Rgas
    end subroutine trend_init_no_char
  end interface

  interface
    subroutine trend_init(nc,path,comps,mix,Rgas)
      implicit none
      integer, intent(in) :: nc
      character (12), dimension (nc), intent(in) :: comps
      character(len=255), intent(inout) :: path
      integer, intent(in) :: mix
      real,    intent(in) :: Rgas
    end subroutine trend_init
  end interface

  interface
    subroutine envelope(moles)
      implicit none
      real, dimension (:), intent(in) :: moles
    end subroutine envelope
  end interface

  interface
    subroutine trend_thermo(t,p,z,phase,lnfug,lnfugt,lnfugp,lnfugn)
      implicit none
      ! Transferred variables
      integer, intent(in) :: phase !< Phase identifyer
      real, intent(in) :: t !< K - Temperature
      real, intent(in) :: p !< Pa - Pressure
      real, dimension(:), intent(in) :: z !< Compozition
      real, dimension(:), intent(out) :: lnfug !< Logarithm of fugasity coefficient
      real, optional, dimension(:), intent(out) :: lnfugt !< 1/K - Logarithm of fugasity coefficient differential wrpt. temperature
      real, optional, dimension(:), intent(out) :: lnfugp !< 1/Pa - Logarithm of fugasity coefficient differential wrpt. pressure
      real, optional, dimension(:,:), intent(out) :: lnfugn !< Logarithm of fugasity coefficient differential wrpt. mole numbers.
    end subroutine trend_thermo
  end interface

  interface
    subroutine trend_enthalpy(t,rho,x,h,dhdt,dhdp,dhdx)
      implicit none
      ! Transferred variables
      real, intent(in) :: rho !< mol/m3 - Density
      real, intent(in) :: t !< K - Temperature
      real, dimension(:), intent(in) :: x !< Compozition
      real, intent(out) :: h !< J/mol - Specific enthalpy
      real, optional, intent(out) :: dhdt !< J/mol/K - Specific enthalpy differential wrpt. temperature
      real, optional, intent(out) :: dhdp !< J/mol/K/Pa - Specific enthalpy differential wrpt. pressure
      real, optional, dimension(:), intent(out) :: dhdx !< J/mol - Specific enthalpy differential wrpt. mole numbers
    end subroutine trend_enthalpy
  end interface

  interface
    subroutine trend_thermo_dens(t,rho,z,lnfug,lnfugt,lnfugp,lnfugn)
      implicit none
      ! Transferred variables
      real, intent(in) :: rho !< mol/m3 - Density
      real, intent(in) :: t !< K - Temperature
      real, dimension(:), intent(in) :: z !< Compozition
      real, dimension(:), intent(out) :: lnfug !< Logarithm of fugasity coefficient
      real, optional, dimension(:), intent(out) :: lnfugt !< 1/K - Logarithm of fugasity coefficient differential wrpt. temperature
      real, optional, dimension(:), intent(out) :: lnfugp !< 1/Pa - Logarithm of fugasity coefficient differential wrpt. pressure
      real, optional, dimension(:,:), intent(out) :: lnfugn !< Logarithm of fugasity coefficient differential wrpt. mole numbers
    end subroutine trend_thermo_dens
  end interface

  interface
    subroutine trend_entropy(t,rho,x,s,dsdt,dsdp,dsdx)
      implicit none
      ! Transferred variables
      real, intent(in) :: rho !< mol/m3 - Density
      real, intent(in) :: t !< K - Temperature
      real, dimension(:), intent(in) :: x !< Compozition
      real, intent(out) :: s !< J/mol/K - Specific entropy
      real, optional, intent(out) :: dsdt !< J/mol/K2 - Specific entropy differential wrpt. temperature
      real, optional, intent(out) :: dsdp !< J/mol/K2/Pa - Specific entropy differential wrpt. pressure
      real, optional, dimension(:), intent(out) :: dsdx !< J/mol 2/K - Specific entropy differential wrpt. mole numbers
    end subroutine trend_entropy
  end interface

  interface
    function trend_pressure(n,t,v,dpdv,dpdt,dpdn) result(p)
      implicit none
      ! Transferred variables
      real, intent(in) :: t !< K - Temperature
    real, intent(in) :: v !< m3 - Specific volume
      real, dimension(:), intent(in) :: n !< Mol numbers
      real, optional, intent(out) :: dpdt !< Pa/K - Pressure differential wrpt. temperature
      real, optional, intent(out) :: dpdv !< Pa/m3 - Pressure differential wrpt. volume
      real, optional, intent(out) :: dpdn(:) !< Pa/mol - Pressure differential wrpt. mol
      real :: p !< Pa - Pressure
    end function trend_pressure
  end interface

  interface
    function trend_dpdrho(x,t,rho) result(dpdrho)
      implicit none
      ! Transferred variables
      real, intent(in) :: t !< K - Temperature
      real, intent(in) :: rho !< mol/m3 - Density
      real, dimension(:), intent(in) :: x !< Compozition
      real :: dpdrho
    end function trend_dpdrho
  end interface

  interface
    function trend_d2Pdrho2(x,T,rho) result(d2Pdrho2)
      implicit none
      ! Transferred variables
      real, intent(in)                :: T !< K - Temperature
      real, intent(in)                :: rho !< mol/m3 - Density
      real, dimension(:), intent(in)  :: x !< Composition
      real :: d2Pdrho2
    end function trend_d2Pdrho2
  end interface

  interface
    function trend_psrk(t,p,x,phase) result(rho)
      implicit none
      ! Transferred variables
      real, intent(in) :: t !< K - Temperature
      real, intent(in) :: p !< Pa - Pressure
      real, dimension(:), intent(in) :: x !< Compozition
      integer, intent(in) :: phase !< Phase indicator
      real :: rho !< mol/m3 - Pressure
    end function trend_psrk
  end interface

  interface
    subroutine trend_rhomax_srk(x,rhomax)
      implicit none
      real, dimension(:), intent(in)  :: x      !< Composition
      real,               intent(out) :: rhomax !< Maximum molar density
    end subroutine trend_rhomax_srk
  end interface

  interface
    subroutine trend_specificVolume(t,x,v,dvdt,dvdp,dvdx)
      implicit none
      ! Transferred variables
      real, intent(in) :: t !< K - Temperature
      real, dimension(:), intent(in) :: x !< Compozition
      real, intent(in) :: v !< m3/mol - Specific volume
      real, optional, intent(out) :: dvdt !< m3/mol/K - Specific volume differential wrpt. temperature
      real, optional, intent(out) :: dvdp !< m3/mol/Pa - Specific volume differential wrpt. pressure
      real, optional, dimension(:), intent(out) :: dvdx !< m3/mol - Specific volume differential wrpt. mole numbers
    end subroutine trend_specificVolume
  end interface

  interface
    function trend_compMoleWeight(j) result(mw)
      implicit none
      ! Transferred variables
      integer, intent(in) :: j !< Component index
      real :: mw !< g/mol - Mole weight
    end function trend_compMoleWeight
  end interface

  interface
    function trend_moleWeight(z) result(mw)
      implicit none
      ! Transferred variables
      real, dimension(:), intent(in) :: z !< Composition
      real :: mw !< g/mol - Mole weight
    end function trend_moleWeight
  end interface

  interface
    subroutine trend_getcrit(i,tci,pci,oi, vci, tnbi)
      implicit none
      ! Transferred variables
      integer, intent(in) :: i !< Component index
      real, intent(out) :: tci !< K - Critical temperature
      real, intent(out) :: pci !< Pa - Critical pressure
      real, intent(out) :: oi  !< Asentric factor
      real, optional, intent(out) :: vci !< Critical specific volume (m3/mol)
      real, optional, intent(out) :: tnbi !< Normal boiling point temperature
    end subroutine trend_getcrit
  end interface

  interface
    subroutine trend_zfac(T, rho, x, zfac, dzdt, dzdp, dzdx)
      implicit none
      ! Input:
      real,   intent(in)          :: T        !< Temperature (K)
      real,   intent(in)          :: rho      !< Density (mol/m^3)
      real,   intent(in)          :: x(:)     !< Composition (mol/mol)
      ! Output:
      real,   intent(out)         :: zfac     !< Compressibility factor (-)
      real, optional, intent(out) :: dzdt     !< zfac diff. wrt. temperature
      real, optional, intent(out) :: dzdp     !< zfac diff. wrt. pressure
      real, optional, intent(out) :: dzdx(:)  !< zfac diff. wrt. composition
    end subroutine trend_zfac
  end interface

  interface
    subroutine trend_residualgibbs_tp(T, p, rho, x, gr, dgrdt, dgrdp)
      implicit none
      ! Input:
      real,   intent(in)          :: T        !< Temperature (K)
      real,   intent(in)          :: p        !< Pressure (Pa)
      real,   intent(in)          :: rho      !< Density (mol/m^3)
      real,   intent(in)          :: x(:)     !< Composition (mol/mol)
      ! Output:
      real,   intent(out)         :: gr     !< Residual Gibbs Energy (J/mol)
      real, optional, intent(out) :: dgrdt  !< Res. Gibbs diff. wrt. temperature
      real, optional, intent(out) :: dgrdp  !< Res. Gibbs diff. wrt. pressure
    end subroutine trend_residualgibbs_tp
  end interface

  interface
    subroutine trend_residualenthalpy_tp(T, p, rho, x, hr, dhrdt, dhrdp, dhrdx)
      implicit none
      ! Input:
      real,   intent(in)          :: T        !< Temperature (K)
      real,   intent(in)          :: p        !< Pressure (Pa)
      real,   intent(in)          :: rho      !< Density (mol/m^3)
      real,   intent(in)          :: x(:)     !< Composition (mol/mol)
      ! Output:
      real,   intent(out)         :: hr     !< Residual enthalpy (J/mol)
      real, optional, intent(out) :: dhrdt  !< Res. enth. diff. wrt. temperature
      real, optional, intent(out) :: dhrdp  !< Res. enth. diff. wrt. pressure
      real, optional, intent(out) :: dhrdx(:)!< Res. enth. diff. wrt. comp
    end subroutine trend_residualenthalpy_tp
  end interface

  interface
    subroutine trend_residualentropy_tp(T,p,rho,x,sr,dsrdt,dsrdp,dsrdx)
      implicit none
      ! Input:
      real, intent(in)                  :: T    !< Temperature (K)
      real, intent(in)                  :: p    !< Pressure (Pa)
      real, intent(in)                  :: rho  !< Density (mol/m3)
      real, dimension(:), intent(in)    :: x    !< Composition (mol/mol)
      ! Output:
      real, intent(out)                 :: sr   !< Specific residual entropy
      ! (J/(mol*K)
      real, optional, intent(out)       :: dsrdt!< Specific residual entropy diff.
      ! wrpt. temperature (J/(mol*K^2)
      real, optional, intent(out)       :: dsrdp!< Specific residual entropy diff.
      ! wrpt. pressure (J/(mol*K*Pa)
      real, optional, intent(out)       :: dsrdx(:) !< Specific residual
      !entropy diff. wrpt. mole numbers
      ! (J/(mol^2*K)
    end subroutine trend_residualentropy_tp
  end interface

  interface
    function trend_speedofsound(T,rho,x) result(c)
      implicit none
      ! Input:
      real,   intent(in)          :: T        !< Temperature (K)
      real,   intent(in)          :: rho      !< Density (mol/m^3)
      real,   intent(in)          :: x(:)  !< Composition (mol/mol)
      ! Output:
      real                        :: c        !< Speed of sound (m/s)
    end function trend_speedofsound
  end interface

  interface
    function trend_ideal_Cp(T,j) result(Cp_id)
      implicit none
      ! Input:
      real,    intent(in)         :: T        !< Temperature (K)
      integer, intent(in)         :: j        !< Component index
      ! Output:
      real                        :: Cp_id    !< Ideal heat capacity (J/mol/K)
    end function trend_ideal_Cp
  end interface

  interface
    function trend_ideal_enthalpy(T,j) result(hid)
      implicit none
      ! Input:
      real,    intent(in)         :: T        !< Temperature (K)
      integer, intent(in)         :: j        !< Component index
      ! Output:
      real                        :: hid      !< Ideal enthalpy (J/mol)
    end function trend_ideal_enthalpy
  end interface

  interface
    function trend_ideal_entropy(T,P,j) result(sid)
      implicit none
      ! Input:
      real,    intent(in)         :: T        !< Temperature (K)
      real,    intent(in)         :: P        !< Density (Pa)
      integer, intent(in)         :: j        !< Component index
      ! Output:
      real                        :: sid      !< Ideal entropy (J/mol/K)
    end function trend_ideal_entropy
  end interface

  interface
    subroutine trend_Get_binary_parameters(i1,i2, ParRedFun, ndf, ParDepFun)
      integer, parameter:: nDim = 25  !Dimensions of array in module_mixture_parameters
      integer, intent(in) :: i1,i2
      real, intent(out):: ParRedFun(5)
      integer, intent(out) :: ndf(2)
      real, intent(out)::ParDepFun(nDim,8)
    end subroutine trend_Get_binary_parameters
  end interface

  interface
    subroutine trend_Set_binary_parameters(i1,i2, ParRedFun, ndf, ParDepFun)
      integer, parameter:: nDim = 25  !Dimensions of array in module_mixture_parameters
      integer, intent(in) :: i1,i2
      real, intent(in):: ParRedFun(5)
      integer, intent(in) :: ndf(2)
      real, intent(in)::ParDepFun(nDim,8)
    end subroutine trend_SEt_Binary_parameters
  end interface

  interface
    subroutine trend_GetReducedRhoT(T, x, RhoRed, TRed)
      implicit none
      real, intent(in) :: T
      real, intent(in) :: x(:)
      real, intent(out):: RhoRed
      real, intent(out)::TRed
    end subroutine trend_GetReducedRhoT
  end interface

  interface
    function trend_GetPVapPure(T, icmp) result(P)
      implicit none
      real, intent(in) :: T
      integer, intent(in):: icmp
      real :: P
    end function trend_GetPVapPure
  end interface

  interface
    function trend_free_energy(x,t,v,dydv,dydt,d2ydt2,d2ydv2,d2ydvdt) result(y)
      implicit none
      ! Transferred variables
      real, intent(in) :: t !< K - Temperature
      real, intent(in) :: v !< m3/mol - Specific volume
      real, dimension(:), intent(in) :: x !< Compozition
      real, optional, intent(out) :: dydt !< J/(mol K) - Helmholtz free energy differential wrpt. temperature
      real, optional, intent(out) :: dydv !< J/m3 - Helmholtz free energy differential wrpt. specific volume
      real, optional, intent(out) :: d2ydt2 !< J/(mol K2) - Helmholtz differential wrpt. temperature
      real, optional, intent(out) :: d2ydv2 !< J/m6 - Helmholtz second differential wrpt. specific volume
      real, optional, intent(out) :: d2ydvdt !< J/(m3 K) - Helmholtz second differential wrpt. specific volume and temperature
      real :: y !< J/mol - Helmholtz free energy
    end function trend_free_energy
  end interface

  interface
    function trend_internal_energy(x,t,v,dudv,dudt) result(u)
      implicit none
      ! Transferred variables
      real, intent(in) :: t !< K - Temperature
      real, intent(in) :: v !< m3/mol - Specific volume
      real, dimension(:), intent(in) :: x !< Compozition
      real, optional, intent(out) :: dudt !< J/(mol K) - Internal energy differential wrpt. temperature
      real, optional, intent(out) :: dudv !< J/m3 - Internal energy differential wrpt. specific volume
      real :: u !< J/mol - Internal energy
    end function trend_internal_energy
  end interface

  interface
    subroutine trend_thermoTV(T,V,n,lnfug,lnfugT,lnfugV,lnfugn)
      real, intent(in) :: T,V,n(:)
      real, optional, intent(out) :: lnfug(:),lnfugT(:)
      real, optional, intent(out) :: lnfugV(:),lnfugn(:,:)
    end subroutine trend_thermoTV
  end interface

  interface
    subroutine trend_CalcFres(T,V,n,F,F_T,F_V,F_n,F_TT,&
         F_TV,F_VV,F_Tn,F_Vn,F_nn)
      implicit none
      real, intent(in) :: T,V,n(:)
      real, optional, intent(out) :: F,F_T,F_V,F_n(:),F_TT,F_TV,F_VV
      real, optional, intent(out) :: F_Tn(:),F_Vn(:),F_nn(:,:)
    end subroutine trend_CalcFres
  end interface

  interface
    subroutine trend_CalcFid(T,V,n,F,F_T,F_V,F_TT,F_TV,F_VV,F_n,F_Tn,F_Vn,F_nn)
      real, intent(in) :: T,V,n(:)
      real, optional, intent(out) :: F,F_T,F_V,F_TT,F_TV,F_VV
      real, optional, intent(out) :: F_n(:),F_Tn(:),F_Vn(:),F_nn(:,:)
    end subroutine trend_CalcFid
  end interface

  interface
    function trend_rmix(x) result(Rmix)
      real, dimension(:), intent(in) :: x
      real :: Rmix
    end function trend_rmix
  end interface

  interface
    subroutine trend_aux_sat_prop(T,i,P,vv,vl)
      implicit none
      real, intent(in) :: T     !< Temperature (K)
      integer, intent(in) :: i  !< Component index
      real, intent(out) :: P    !< Pressure (Pa)
      real, intent(out) :: vv   !< Vapour volume (m3/mol)
      real, intent(out) :: vl   !< Liquid volume (m3/mol)
    end subroutine trend_aux_sat_prop
  end interface

  interface
    subroutine trend_ideal(T,i,Cp,h,s)
      implicit none
      real, intent(in) :: T     !< Temperature (K)
      integer, intent(in) :: i  !< Component index
      real, optional, intent(out) :: Cp  !< Heat capcity at constant prerssure (J/mol/K)
      real, optional, intent(out) :: h   !< Enthalpy (J/mol)
      real, optional, intent(out) :: s   !< Entropy (J/mol/K)
    end subroutine trend_ideal
  end interface

max_stars_repo_name: SINTEF/Thermopack

max_issues_repo_name: SINTEF/Thermopack

max_forks_repo_name: SINTEF/Thermopack


!-----------------------------------------------------------------------------
!
! HG (Hydraulic Geometry)
!
! The subroutine HG determines the hillslope an channel cells within the
! catchment and assign the hydraulic geometry parameters.
!
!-----------------------------------------------------------------------------

subroutine hg()

use mpar
use mbbio

implicit none

integer(kind=ISP) hcID
integer(kind=ISP) i_basin,i_basin_chiusura
integer(kind=ISP) n_o_quota

real(kind=REP) A_inflow,A_outflow
real(kind=RSP) w_1,w_2
real(kind=RSP) Ws1_sf_1,Ws1_sf_2,b1_sf,kSs1_sf_1,kSs1_sf_2,y1_sf,nrc

! open the binary file qoi

open(16,file='qoi',access='direct',status='unknown',form='unformatted',recl=4)
open(17,file='qoi_a',status='unknown')

! identify the outlet cell (the lowest catchment cell)
! read(16,rec=N_celle+1) i_basin_chiusura
! write(6,*) 'i_basin_chiusura = ' , i_basin_chiusura

write(17,*) N_celle

do n_o_quota=1,N_celle
   read(16,rec=n_o_quota+1) i_basin
   WRITE(17,*) i_basin
   A_inflow=dtm_A_inflow(i_basin)       ! 17
   w_1=dtm_w_1(i_basin)                 ! 18
   w_2=dtm_w_2(i_basin)                 ! 19
   Ws1_sf_1=dtm_Ws1_sf_1(i_basin)       ! 23
   Ws1_sf_2=dtm_Ws1_sf_2(i_basin)       ! 24
   b1_sf=dtm_b1_sf(i_basin)             ! 25
   kSs1_sf_1=dtm_kSs1_sf_1(i_basin)     ! 26
   kSs1_sf_2=dtm_kSs1_sf_2(i_basin)     ! 27
   y1_sf=dtm_y1_sf(i_basin)             ! 28
   hcID=dtm_hcID(i_basin)               ! 31
   nrc=dtm_nrc(i_basin)                 ! 37

   A_outflow=A_inflow+delta_x*delta_y

   call HydraulicGeometry(hcID,A_outflow,w_1,w_2, &
   Ws1_sf_1,Ws1_sf_2,b1_sf,kSs1_sf_1,kSs1_sf_2,y1_sf,nrc)

   call set_Ws1_sf_1(i_basin,Ws1_sf_1)     ! 23
   call set_Ws1_sf_2(i_basin,Ws1_sf_2)     ! 24
   call set_b1_sf(i_basin,b1_sf)           ! 25
   call set_KSs1_sf_1(i_basin,KSs1_sf_1)   ! 26
   call set_KSs1_sf_2(i_basin,KSs1_sf_2)   ! 27
   call set_y1_sf(i_basin,y1_sf)           ! 28
   call set_nrc(i_basin,nrc)               ! 37

end do

close(16)
close(17)

return
end subroutine hg

subroutine HydraulicGeometry(hcID,A_outflow,w_1,w_2, &
Ws1_sf_1,Ws1_sf_2,b1_sf,kSs1_sf_1,kSs1_sf_2,y1_sf,nrc)

use mpar
implicit none
integer(kind=ISP),intent(in) :: hcID
real(kind=REP),intent(in) :: A_outflow
real(kind=RSP),intent(in) :: w_1,w_2
real(kind=RSP),intent(inout) :: Ws1_sf_1,Ws1_sf_2,b1_sf
real(kind=RSP),intent(inout) :: kSs1_sf_1,kSs1_sf_2,y1_sf
real(kind=RSP),intent(inout) :: nrc
real(kind=REP) :: RA

if (hcID.eq.0) then ! rill flow
   RA=A_outflow/As_rf
   if (b1_sf.eq.0.0E0) b1_sf=b1_rf
   if (Ws1_sf_1.eq.0.0E0.and.abs(w_1).gt.epsilon(w_1)) &
   Ws1_sf_1=Wsf_rf*Qsf_rf**(-b1_sf)*(RA*w_1)**(w_rf*(b2_rf-b1_sf))
   if (Ws1_sf_2.eq.0.0E0.and.abs(w_2).gt.epsilon(w_2)) &
   Ws1_sf_2=Wsf_rf*Qsf_rf**(-b1_sf)*(RA*w_2)**(w_rf*(b2_rf-b1_sf))
   if (y1_sf.eq.0.0E0) y1_sf=y1_rf
   if (kSs1_sf_1.eq.0.0E0.and.abs(w_1).gt.epsilon(w_1)) &
   kSs1_sf_1=kSsf_rf*Qsf_rf**(-y1_sf)*(RA*w_1)**(w_rf*(y2_rf-y1_sf))
   if (kSs1_sf_2.eq.0.0E0.and.abs(w_2).gt.epsilon(w_2)) &
   kSs1_sf_2=kSsf_rf*Qsf_rf**(-y1_sf)*(RA*w_2)**(w_rf*(y2_rf-y1_sf))
   if (nrc.eq.0.0E0) nrc=delta_x/dr
else ! if (hcID.eq.1) then ! channel flow
   RA=A_outflow/As_cf
   if (b1_sf.eq.0.0E0) b1_sf=b1_cf
   if (Ws1_sf_1.eq.0.0E0.and.abs(w_1).gt.epsilon(w_1)) &
   Ws1_sf_1=Wsf_cf*Qsf_cf**(-b1_sf)*(RA*w_1)**(w_cf*(b2_cf-b1_sf))
   if (Ws1_sf_2.eq.0.0E0.and.abs(w_2).gt.epsilon(w_2)) &
   Ws1_sf_2=Wsf_cf*Qsf_cf**(-b1_sf)*(RA*w_2)**(w_cf*(b2_cf-b1_sf))
   if (y1_sf.eq.0.0E0) y1_sf=y1_cf
   if (kSs1_sf_1.eq.0.0E0.and.abs(w_1).gt.epsilon(w_1)) &
   kSs1_sf_1=kSsf_cf*Qsf_cf**(-y1_sf)*(RA*w_1)**(w_cf*(y2_cf-y1_sf))
   if (kSs1_sf_2.eq.0.0E0.and.abs(w_2).gt.epsilon(w_2)) &
   kSs1_sf_2=kSsf_cf*Qsf_cf**(-y1_sf)*(RA*w_2)**(w_cf*(y2_cf-y1_sf))
   if (nrc.eq.0.0E0) nrc=1.0
end if

end subroutine HydraulicGeometry


text:
A Davis campus fight song written by alumnus and former Aggie Band Aggie Bandsman Greg Sweatt.  Probably composed in the late 1970s or early 1980s, its lyrics reference the mascots of some of the Northern California Athletic Conference opponents that the Aggies regularly faced until the conference dissolved in the 1990s, as well as Sac State. This is one of the Aggie songs.

{{{Here come the Aggies, here comes the band,
Spreading our colors over the land.
Because the Blue and Gold will carry the day,
Charging the Mustang into the fray.
Wipe out the Hornet, declaw the Cat,
Swallow the Gator, chop down the Jack.
Well fight for alma mater, body and soul
Were gonna roll, big CA, roll!}}}

The CA in the title is not the abbreviation of California but the acronym of California Aggies, as in the Oldschool Aggie Logo.

ext: f

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


text:
	SUBROUTINE PDS_BYT9  ( parm, wmotb, nceptb, byte9, ibyt9,
     +                         idt, iret )
C************************************************************************
C* PDS_BYT9								*
C*									*
C* This subroutine uses the GEMPAK GRIB parameter lookup tables to	*
C* determine the value of PDS octet 9.					*
C*									*
C* PDS_BYT9  ( PARM, WMOTB, NCEPTB, BYTE9, IBYT9, IDT, IRET )		*
C*									*
C* Input parameters:							*
C*	PARM		CHAR*		GEMPAK parameter name string	*
C*	WMOTB		CHAR*		WMO GRIB parm LUT file name	*
C*	NCEPTB		CHAR*		NCEP GRIB parm LUT file name	*
C*									*
C* Output parameters:							*
C*	BYTE9		CHAR*1		Byte with GRIB parm # stored	*
C*	IBYT9		INTEGER		Integer value of byte 9		*
C*	IDT		INTEGER		Value of any imbedded integer	*
C*	IRET		INTEGER		Return code			*
C*					  0 = normal return		*
C*					-83 = parm not found		*
C*					-84 = parm # not valid in GRIB	*
C*					-94 = parm name is too long	*
C**									*
C* Log:									*
C* K. Brill/HPC		 8/99						*
C* K. Brill/HPC		 3/00	Avoid character assignment to itself	*
C************************************************************************
	INCLUDE		'GEMPRM.PRM'
	CHARACTER*(*)	parm, wmotb, nceptb
	CHARACTER*1	byte9
C*
	LOGICAL		found
	CHARACTER*256	filnam (2), record
	CHARACTER*16	prmnam, chkprm, cinprm, cnum
	CHARACTER*1	cdum
C------------------------------------------------------------------------
	iret = 0
	idt = -9999
	byte9 = CHAR ( 255 )
	ibyt9 = 255
	CALL ST_LSTR ( parm, ln2, ier )
	IF ( ln2 .gt. 16 ) THEN
	    iret = -94
	    RETURN
	END IF
	CALL ST_LCUC ( parm, cinprm, ier )
	filnam (1) = wmotb
	filnam (2) = nceptb
	found = .false.
	ifile = 0
	DO WHILE ( ifile .lt. 2 .and. .not. found )
	    ifile = ifile + 1
	    IF ( filnam (ifile) .ne. ' ' ) THEN
		CALL FL_TBOP ( filnam (ifile), 'grid', luntbl, ios )
	    ELSE
		ios = -99
	    END IF
	    DO WHILE ( ios .eq. 0 .and. .not. found )
		READ (luntbl,'(A)',IOSTAT=ios) record
		IF ( ios .eq. 0 ) THEN
		    IF ( record (1:1) .ne. '!' ) THEN
			READ (record,'(I3,56X,A12)',IOSTAT=ier)
     +			    iprm, prmnam
			IF ( ier .eq. 0 ) THEN
			    cnum = ' '
			    chkprm = cinprm
			    CALL ST_LSTR ( prmnam, ln1, ier )
			    ifnd1 = INDEX ( chkprm, prmnam (1:ln1) )
			    IF ( prmnam (1:ln1) .eq.
     + 				 chkprm (1:ln2) ) THEN
				found = .true.
				ibyt9 = iprm
			    ELSE IF ( ifnd1 .eq. 1 ) THEN
				cnum = chkprm (ln1+1:ln2)
				CALL ST_NUMB ( cnum, idt, ier )
				found = ( ier .eq. 0 )
				IF ( found ) ibyt9 = iprm
			    ELSE
				idash = INDEX ( prmnam, '-' )
				IF ( idash .ne. 0 ) THEN
				    nnums = 0
				    kchr = 0
				    DO ic = 1, ln2
					CALL ST_ALNM ( chkprm (ic:ic),
     +						       ityp, ier )
					IF ( ityp .eq. 1 ) THEN
					    nnums = nnums + 1
					    cnum (nnums:nnums) =
     +							chkprm (ic:ic)
					    IF ( nnums .le. 2 ) THEN
						kchr = kchr + 1
						chkprm (kchr:kchr) =
     +								'-'
					    END IF
					ELSE
					    kchr = kchr + 1
					    cdum =
     +						chkprm (ic:ic)
					    chkprm (kchr:kchr) =
     +						cdum
					END IF
				    END DO
				    IF ( nnums .gt. 0 ) THEN
					found = ( chkprm (1:kchr)
     +					          .eq. prmnam (1:ln1) )
					IF ( found ) THEN
					    CALL ST_NUMB ( cnum, idt,
     +							   ier )
					    ibyt9 = iprm
					END IF
				    END IF
				END IF
			    END IF
			END IF
		    END IF
		END IF
	    END DO
	    CALL FL_CLOS ( luntbl, ier )
	END DO
	IF ( .not. found ) THEN
	    iret = -83
	ELSE IF ( ibyt 9 .lt. 255 .and. ibyt9 .gt. 0 ) THEN
	    byte9 = CHAR ( ibyt9 )
	ELSE
	    iret = -84
	END IF
C*
	RETURN
	END

max_stars_repo_name: oxelson/gempak

max_issues_repo_name: oxelson/gempak

max_forks_repo_name: oxelson/gempak


text:
module git2_repository
    use, intrinsic :: iso_c_binding
    use :: git2_annotated_commit
    use :: git2_buffer
    use :: git2_oid
    implicit none
    private

    ! git_configmap_item
    integer(kind=c_int), parameter, public :: GIT_CONFIGMAP_AUTO_CRLF        = 0
    integer(kind=c_int), parameter, public :: GIT_CONFIGMAP_EOL              = 1
    integer(kind=c_int), parameter, public :: GIT_CONFIGMAP_SYMLINKS         = 2
    integer(kind=c_int), parameter, public :: GIT_CONFIGMAP_IGNORECASE       = 3
    integer(kind=c_int), parameter, public :: GIT_CONFIGMAP_FILEMODE         = 4
    integer(kind=c_int), parameter, public :: GIT_CONFIGMAP_IGNORESTAT       = 5
    integer(kind=c_int), parameter, public :: GIT_CONFIGMAP_TRUSTCTIME       = 6
    integer(kind=c_int), parameter, public :: GIT_CONFIGMAP_ABBREV           = 7
    integer(kind=c_int), parameter, public :: GIT_CONFIGMAP_PRECOMPOSE       = 8
    integer(kind=c_int), parameter, public :: GIT_CONFIGMAP_SAFE_CRLF        = 9
    integer(kind=c_int), parameter, public :: GIT_CONFIGMAP_LOGALLREFUPDATES = 10
    integer(kind=c_int), parameter, public :: GIT_CONFIGMAP_PROTECTHFS       = 11
    integer(kind=c_int), parameter, public :: GIT_CONFIGMAP_PROTECTNTFS      = 12
    integer(kind=c_int), parameter, public :: GIT_CONFIGMAP_FSYNCOBJECTFILES = 13
    integer(kind=c_int), parameter, public :: GIT_CONFIGMAP_CACHE_MAX        = 14

    ! git_repository_init_options
    type, bind(c), public :: git_repository_init_options
        integer(kind=c_int)     :: version
        integer(kind=c_int32_t) :: flags
        integer(kind=c_int32_t) :: mode
        type(c_ptr)             :: workdir_path
        type(c_ptr)             :: description
        type(c_ptr)             :: template_path
        type(c_ptr)             :: initial_head
        type(c_ptr)             :: origin_url
    end type git_repository_init_options

    public :: git_repository_path
    public :: git_repository_workdir
    public :: git_repository_commondir
    public :: git_repository_get_namespace
    public :: git_repository_open
    public :: git_repository_open_from_worktree
    public :: git_repository_wrap_odb
    public :: git_repository_discover
    public :: git_repository_open_ext
    public :: git_repository_open_bare
    public :: git_repository_init
    public :: git_repository_init_options_init
    public :: git_repository_init_ext
    public :: git_repository_head
    public :: git_repository_head_for_worktree
    public :: git_repository_head_detached
    public :: git_repository_head_detached_for_worktree
    public :: git_repository_head_unborn
    public :: git_repository_is_empty
    public :: git_repository_item_path
    public :: git_repository_set_workdir
    public :: git_repository_is_bare
    public :: git_repository_is_worktree
    public :: git_repository_config
    public :: git_repository_config_snapshot
    public :: git_repository_odb
    public :: git_repository_refdb
    public :: git_repository_index
    public :: git_repository_message
    public :: git_repository_message_remove
    public :: git_repository_state_cleanup
    public :: git_repository_fetchhead_foreach
    public :: git_repository_mergehead_foreach
    public :: git_repository_hashfile
    public :: git_repository_set_head
    public :: git_repository_set_head_detached
    public :: git_repository_set_head_detached_from_annotated
    public :: git_repository_detach_head
    public :: git_repository_state
    public :: git_repository_set_namespace
    public :: git_repository_is_shallow
    public :: git_repository_ident
    public :: git_repository_set_ident
    public :: git_repository_free

    interface
        ! const char *git_repository_path(const git_repository *repo)
        function git_repository_path(repo) bind(c, name='git_repository_path')
            import :: c_ptr
            type(c_ptr), intent(in), value :: repo
            type(c_ptr) :: git_repository_path
        end function git_repository_path

        ! const char *git_repository_workdir(const git_repository *repo)
        function git_repository_workdir(repo) bind(c, name='git_repository_workdir')
            import :: c_ptr
            type(c_ptr), intent(in), value :: repo
            type(c_ptr) :: git_repository_workdir
        end function git_repository_workdir

        ! const char *git_repository_commondir(const git_repository *repo)
        function git_repository_commondir(repo) bind(c, name='git_repository_commondir')
            import :: c_ptr
            type(c_ptr), intent(in), value :: repo
            type(c_ptr) :: git_repository_commondir
        end function git_repository_commondir

        ! const char *git_repository_get_namespace(git_repository *repo)
        function git_repository_get_namespace(repo) bind(c, name='git_repository_get_namespace')
            import :: c_ptr
            type(c_ptr), intent(in), value :: repo
            type(c_ptr) :: git_repository_get_namespace
        end function git_repository_get_namespace

        ! int git_repository_open(git_repository **out, const char *path)
        function git_repository_open(out, path) bind(c, name='git_repository_open')
            import :: c_char, c_int, c_ptr
            type(c_ptr), intent(out) :: out
            character(kind=c_char), intent(in) :: path
            integer(kind=c_int) :: git_repository_open
        end function git_repository_open

        ! int git_repository_open_from_worktree(git_repository **out, git_worktree *wt)
        function git_repository_open_from_worktree(out, wt) bind(c, name='git_repository_open_from_worktree')
            import :: c_int, c_ptr
            type(c_ptr), intent(out) :: out
            type(c_ptr), intent(in), value :: wt
            integer(kind=c_int) :: git_repository_open_from_worktree
        end function git_repository_open_from_worktree

        ! int git_repository_wrap_odb(git_repository **out, git_odb *odb)
        function git_repository_wrap_odb(out, odb) bind(c, name='git_repository_wrap_odb')
            import :: c_int, c_ptr
            type(c_ptr), intent(out) :: out
            type(c_ptr), intent(in), value :: odb
            integer(kind=c_int) :: git_repository_wrap_odb
        end function git_repository_wrap_odb

        ! int git_repository_discover(git_buf *out, const char *start_path, bool across_fs, const char *ceiling_dirs)
        function git_repository_discover(out, start_path, across_fs, ceiling_dirs) bind(c, name='git_repository_discover')
            import :: c_bool, c_char, c_int, git_buf
            type(git_buf), intent(out) :: out
            character(kind=c_char), intent(in) :: start_path
            logical(kind=c_bool), intent(in), value :: across_fs
            character(kind=c_char), intent(in) :: ceiling_dirs
            integer(kind=c_int) :: git_repository_discover
        end function git_repository_discover

        ! int git_repository_open_ext(git_repository **out, const char *path, unsigned int flags, const char *ceiling_dirs)
        function git_repository_open_ext(out, path, flags, ceiling_dirs) bind(c, name='git_repository_open_ext')
            import :: c_char, c_int, c_ptr
            type(c_ptr), intent(out) :: out
            character(kind=c_char), intent(in) :: path
            integer(kind=c_int), intent(in), value :: flags
            character(kind=c_char), intent(in) :: ceiling_dirs
            integer(kind=c_int) :: git_repository_open_ext
        end function git_repository_open_ext

        ! int git_repository_open_bare(git_repository **out, const char *bare_path)
        function git_repository_open_bare(out, bare_path) bind(c, name='git_repository_open_bare')
            import :: c_char, c_int, c_ptr
            type(c_ptr), intent(out) :: out
            character(kind=c_char), intent(in) :: bare_path
            integer(kind=c_int) :: git_repository_open_bare
        end function git_repository_open_bare

        ! int git_repository_init(git_repository **out, const char *path, bool is_bare)
        function git_repository_init(out, path, is_bare) bind(c, name='git_repository_init')
            import :: c_bool, c_char, c_int, c_ptr
            type(c_ptr), intent(out) :: out
            character(kind=c_char), intent(in) :: path
            logical(kind=c_bool), intent(in), value :: is_bare
            integer(kind=c_int) :: git_repository_init
        end function git_repository_init

        ! int git_repository_init_options_init(git_repository_init_options *opts, unsigned int version)
        function git_repository_init_options_init(opts, version) bind(c, name='git_repository_init_options_init')
            import :: c_int, git_repository_init_options
            type(git_repository_init_options), intent(in) :: opts
            integer(kind=c_int), intent(in), value :: version
            integer(kind=c_int) :: git_repository_init_options_init
        end function git_repository_init_options_init

        ! int git_repository_init_ext(git_repository **out, const char *repo_path, git_repository_init_options *opts)
        function git_repository_init_ext(out, repo_path, opts) bind(c, name='git_repository_init_ext')
            import :: c_char, c_int, c_ptr, git_repository_init_options
            type(c_ptr), intent(out) :: out
            character(kind=c_char), intent(in) :: repo_path
            type(git_repository_init_options), intent(in) :: opts
            integer(kind=c_int) :: git_repository_init_ext
        end function git_repository_init_ext

        ! int git_repository_head(git_reference **out, git_repository *repo)
        function git_repository_head(out, repo) bind(c, name='git_repository_head')
            import :: c_int, c_ptr
            type(c_ptr), intent(out) :: out
            type(c_ptr), intent(in), value :: repo
            integer(kind=c_int) :: git_repository_head
        end function git_repository_head

        ! int git_repository_head_for_worktree(git_reference **out, git_repository *repo, const char *name)
        function git_repository_head_for_worktree(out, repo, name) bind(c, name='git_repository_head_for_worktree')
            import :: c_char, c_int, c_ptr
            type(c_ptr), intent(out) :: out
            type(c_ptr), intent(in), value :: repo
            character(kind=c_char), intent(in) :: name
            integer(kind=c_int) :: git_repository_head_for_worktree
        end function git_repository_head_for_worktree

        ! int git_repository_head_detached(git_repository *repo)
        function git_repository_head_detached(repo) bind(c, name='git_repository_head_detached')
            import :: c_int, c_ptr
            type(c_ptr), intent(in), value :: repo
            integer(kind=c_int) :: git_repository_head_detached
        end function git_repository_head_detached

        ! int git_repository_head_detached_for_worktree(git_repository *repo, const char *name)
        function git_repository_head_detached_for_worktree(repo, name) bind(c, name='git_repository_head_detached_for_worktree')
            import :: c_char, c_int, c_ptr
            type(c_ptr), intent(in), value :: repo
            character(kind=c_char), intent(in) :: name
            integer(kind=c_int) :: git_repository_head_detached_for_worktree
        end function git_repository_head_detached_for_worktree

        ! int git_repository_head_unborn(git_repository *repo)
        function git_repository_head_unborn(repo) bind(c, name='git_repository_head_unborn')
            import :: c_int, c_ptr
            type(c_ptr), intent(in), value :: repo
            integer(kind=c_int) :: git_repository_head_unborn
        end function git_repository_head_unborn

        ! int git_repository_is_empty(git_repository *repo)
        function git_repository_is_empty(repo) bind(c, name='git_repository_is_empty')
            import :: c_int, c_ptr
            type(c_ptr), intent(in), value :: repo
            integer(kind=c_int) :: git_repository_is_empty
        end function git_repository_is_empty

        ! int git_repository_item_path(git_buf *out, const git_repository *repo, git_repository_item_t item)
        function git_repository_item_path(out, repo, item) bind(c, name='git_repository_item_path')
            import :: c_int, c_ptr, git_buf
            type(git_buf), intent(out) :: out
            type(c_ptr), intent(in), value :: repo
            integer(kind=c_int), intent(in), value :: item
            integer(kind=c_int) :: git_repository_item_path
        end function git_repository_item_path

        ! int git_repository_set_workdir(git_repository *repo, const char *workdir, int update_gitlink)
        function git_repository_set_workdir(repo, workdir, update_gitlink) bind(c, name='git_repository_set_workdir')
            import :: c_char, c_int, c_ptr
            type(c_ptr), intent(in), value :: repo
            character(kind=c_char), intent(in) :: workdir
            integer(kind=c_int), intent(in), value :: update_gitlink
            integer(kind=c_int) :: git_repository_set_workdir
        end function git_repository_set_workdir

        ! int git_repository_is_bare(const git_repository *repo)
        function git_repository_is_bare(repo) bind(c, name='git_repository_is_bare')
            import :: c_int, c_ptr
            type(c_ptr), intent(in), value :: repo
            integer(kind=c_int) :: git_repository_is_bare
        end function git_repository_is_bare

        ! int git_repository_is_worktree(const git_repository *repo)
        function git_repository_is_worktree(repo) bind(c, name='git_repository_is_worktree')
            import :: c_int, c_ptr
            type(c_ptr), intent(in), value :: repo
            integer(kind=c_int) :: git_repository_is_worktree
        end function git_repository_is_worktree

        ! int git_repository_config(git_config **out, git_repository *repo)
        function git_repository_config(out, repo) bind(c, name='git_repository_config')
            import :: c_int, c_ptr
            type(c_ptr), intent(out) :: out
            type(c_ptr), intent(in), value :: repo
            integer(kind=c_int) :: git_repository_config
        end function git_repository_config

        ! int git_repository_config_snapshot(git_config **out, git_repository *repo)
        function git_repository_config_snapshot(out, repo) bind(c, name='git_repository_config_snapshot')
            import :: c_int, c_ptr
            type(c_ptr), intent(out) :: out
            type(c_ptr), intent(in), value :: repo
            integer(kind=c_int) :: git_repository_config_snapshot
        end function git_repository_config_snapshot

        ! int git_repository_odb(git_odb **out, git_repository *repo)
        function git_repository_odb(out, repo) bind(c, name='git_repository_odb')
            import :: c_int, c_ptr
            type(c_ptr), intent(out) :: out
            type(c_ptr), intent(in), value :: repo
            integer(kind=c_int) :: git_repository_odb
        end function git_repository_odb

        ! int git_repository_refdb(git_refdb **out, git_repository *repo)
        function git_repository_refdb(out, repo) bind(c, name='git_repository_refdb')
            import :: c_int, c_ptr
            type(c_ptr), intent(out) :: out
            type(c_ptr), intent(in), value :: repo
            integer(kind=c_int) :: git_repository_refdb
        end function git_repository_refdb

        ! int git_repository_index(git_index **out, git_repository *repo)
        function git_repository_index(out, repo) bind(c, name='git_repository_index')
            import :: c_int, c_ptr
            type(c_ptr), intent(out) :: out
            type(c_ptr), intent(in), value :: repo
            integer(kind=c_int) :: git_repository_index
        end function git_repository_index

        ! int git_repository_message(git_buf *out, git_repository *repo)
        function git_repository_message(out, repo) bind(c, name='git_repository_message')
            import :: c_int, c_ptr, git_buf
            type(git_buf), intent(out) :: out
            type(c_ptr), intent(in), value :: repo
            integer(kind=c_int) :: git_repository_message
        end function git_repository_message

        ! int git_repository_message_remove(git_repository *repo)
        function git_repository_message_remove(repo) bind(c, name='git_repository_message_remove')
            import :: c_int, c_ptr
            type(c_ptr), intent(in), value :: repo
            integer(kind=c_int) :: git_repository_message_remove
        end function git_repository_message_remove

        ! int git_repository_state_cleanup(git_repository *repo)
        function git_repository_state_cleanup(repo) bind(c, name='git_repository_state_cleanup')
            import :: c_int, c_ptr
            type(c_ptr), intent(in), value :: repo
            integer(kind=c_int) :: git_repository_state_cleanup
        end function git_repository_state_cleanup

        ! int git_repository_fetchhead_foreach(git_repository *repo, git_repository_fetchhead_foreach_cb callback, void *payload)
        function git_repository_fetchhead_foreach(repo, callback, payload) bind(c, name='git_repository_fetchhead_foreach')
            import :: c_funptr, c_int, c_ptr
            type(c_ptr), intent(in), value :: repo
            type(c_funptr), intent(in), value :: callback
            type(c_ptr), intent(in), value :: payload
            integer(kind=c_int) :: git_repository_fetchhead_foreach
        end function git_repository_fetchhead_foreach

        ! int git_repository_mergehead_foreach(git_repository *repo, git_repository_mergehead_foreach_cb callback, void *payload)
        function git_repository_mergehead_foreach(repo, callback, payload) bind(c, name='git_repository_mergehead_foreach')
            import :: c_funptr, c_int, c_ptr
            type(c_ptr), intent(in), value :: repo
            type(c_funptr), intent(in), value :: callback
            type(c_ptr), intent(in), value :: payload
            integer(kind=c_int) :: git_repository_mergehead_foreach
        end function git_repository_mergehead_foreach

        ! int git_repository_hashfile(git_oid *out, git_repository *repo, const char *path, git_object_t type, const char *as_path)
        function git_repository_hashfile(out, repo, path, type, as_path) bind(c, name='git_repository_hashfile')
            import :: c_char, c_int, c_ptr, git_oid
            type(git_oid), intent(out) :: out
            type(c_ptr), intent(in), value :: repo
            character(kind=c_char), intent(in) :: path
            integer(kind=c_int), intent(in), value :: type
            character(kind=c_char), intent(in) :: as_path
            integer(kind=c_int) :: git_repository_hashfile
        end function git_repository_hashfile

        ! int git_repository_set_head(git_repository *repo, const char *refname)
        function git_repository_set_head(repo, refname) bind(c, name='git_repository_set_head')
            import :: c_char, c_int, c_ptr
            type(c_ptr), intent(in), value :: repo
            character(kind=c_char), intent(in) :: refname
            integer(kind=c_int) :: git_repository_set_head
        end function git_repository_set_head

        ! int git_repository_set_head_detached(git_repository *repo, const git_oid *commitish)
        function git_repository_set_head_detached(repo, commitish) bind(c, name='git_repository_set_head_detached')
            import :: c_int, c_ptr, git_oid
            type(c_ptr), intent(in), value :: repo
            type(git_oid), intent(in) :: commitish
            integer(kind=c_int) :: git_repository_set_head_detached
        end function git_repository_set_head_detached

        ! int git_repository_set_head_detached_from_annotated(git_repository *repo, const git_annotated_commit *commitish)
        function git_repository_set_head_detached_from_annotated(repo, commitish) &
                bind(c, name='git_repository_set_head_detached_from_annotated')
            import :: c_int, c_ptr
            type(c_ptr), intent(in), value :: repo
            type(c_ptr), intent(in), value :: commitish
            integer(kind=c_int) :: git_repository_set_head_detached_from_annotated
        end function git_repository_set_head_detached_from_annotated

        ! int git_repository_detach_head(git_repository *repo)
        function git_repository_detach_head(repo) bind(c, name='git_repository_detach_head')
            import :: c_int, c_ptr
            type(c_ptr), intent(in), value :: repo
            integer(kind=c_int) :: git_repository_detach_head
        end function git_repository_detach_head

        ! int git_repository_state(git_repository *repo)
        function git_repository_state(repo) bind(c, name='git_repository_state')
            import :: c_int, c_ptr
            type(c_ptr), intent(in), value :: repo
            integer(kind=c_int) :: git_repository_state
        end function git_repository_state

        ! int git_repository_set_namespace(git_repository *repo, const char *nmspace)
        function git_repository_set_namespace(repo, nmspace) bind(c, name='git_repository_set_namespace')
            import :: c_char, c_int, c_ptr
            type(c_ptr), intent(in), value :: repo
            character(kind=c_char), intent(in) :: nmspace
            integer(kind=c_int) :: git_repository_set_namespace
        end function git_repository_set_namespace

        ! int git_repository_is_shallow(git_repository *repo)
        function git_repository_is_shallow(repo) bind(c, name='git_repository_is_shallow')
            import :: c_int, c_ptr
            type(c_ptr), intent(in), value :: repo
            integer(kind=c_int) :: git_repository_is_shallow
        end function git_repository_is_shallow

        ! int git_repository_ident(const char **name, const char **email, const git_repository *repo)
        function git_repository_ident(name, email, repo) bind(c, name='git_repository_ident')
            import :: c_int, c_ptr
            type(c_ptr), intent(in) :: name
            type(c_ptr), intent(in) :: email
            type(c_ptr), intent(in), value :: repo
            integer(kind=c_int) :: git_repository_ident
        end function git_repository_ident

        ! int git_repository_set_ident(git_repository *repo, const char *name, const char *email)
        function git_repository_set_ident(repo, name, email) bind(c, name='git_repository_set_ident')
            import :: c_char, c_int, c_ptr
            type(c_ptr), intent(in), value :: repo
            character(kind=c_char), intent(in) :: name
            character(kind=c_char), intent(in) :: email
            integer(kind=c_int) :: git_repository_set_ident
        end function git_repository_set_ident

        ! void git_repository_free(git_repository *repo)
        subroutine git_repository_free(repo) bind(c, name='git_repository_free')
            import :: c_ptr
            type(c_ptr), intent(in), value :: repo
        end subroutine git_repository_free
    end interface
end module git2_repository

max_stars_repo_name: interkosmos/fortran-git

max_issues_repo_name: interkosmos/fortran-git

max_forks_repo_name: interkosmos/fortran-git