text:
!     Bug: make sure that labels 100, 200 and 300 are properly regenerated.

      program loop_interchange06

      implicit none
      integer NUM
      parameter(NUM=50)
      integer  i,j, k
      real     a(1:NUM,1:NUM,1:NUM), b(1:NUM,1:NUM,1:NUM),
     &     c(1:NUM,1:NUM,1:NUM)
      real x

      a = 0
      b = 0
      c = 0

      do 300 i = 1, NUM
         do 200 j = 1, NUM
            do 100 k = 1, NUM
               if(x.gt.0.) go to 100
               c(k,j,i) = c(k,j,i) + a(k,j,i) * b(k,j,i)
 100        continue
 200     continue
 300  continue

      end

ext: f


text: Avant Page is a local business that provides translation services.  They provided translation for Dungeons and Dragons Wizards of the Coasts Magic the Gathering Cards card game.

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


text:
c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1990  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ####################################################################
c     ##                                                                ##
c     ##  program testhesssparse -- Hessian matrix test; cart. version  ##
c     ##                                                                ##
c     ####################################################################
c
c
c     "testhesssparse" computes sparse
c     Hessian matrices of the potential energy function with respect
c     to Cartesian coordinates
c     -- modified from testhess.f by htna
c
c
      program testhesssparse
      use sizes
      use atoms
      use files
      use hescut
      use inform
      use iounit
      use usage
      implicit none
      integer i,j,k,m
      integer ii,jj
      integer ixyz,ihes
      integer index,maxnum
      integer next,frame
      integer freeunit
      integer*8 maxhess, maxhess0
      integer errhindex, errh
      integer, allocatable :: hindex(:)
      integer, allocatable :: hinit(:,:)
      integer, allocatable :: hstop(:,:)
      real*8 energy,e,old,eps,eps0
      real*8 diff,delta,sum
      real*8, allocatable :: h(:)
      real*8, allocatable :: g(:,:)
      real*8, allocatable :: g0(:,:)
      real*8, allocatable :: hdiag(:,:)
      real*8, allocatable :: nhess(:,:,:,:)
      logical doanalyt
c     logical donumer
c     logical dograd,dofull
      logical exist,query
      logical identical
      character*1 answer
      character*1 axis(3)
      character*120 xyzfile
      character*120 hessfile
      character*120 record
      character*120 string
      external energy
      data axis  / 'X','Y','Z' /
c
c
c     set up the structure and mechanics calculation
c
      call initial
      call getxyz
      call mechanic
c
c     set difference threshhold via the energy precision
c
      delta = 1.0d-4
      if (digits .ge. 6)  delta = 1.0d-6
      if (digits .ge. 8)  delta = 1.0d-8
c
c     decide whether to do an analytical Hessian calculation
c
      doanalyt = .true.
cc    call nextarg (answer,exist)
cc    if (.not. exist) then
cc       write (iout,10)
cc 10    format (/,' Compute Analytical Hessian Matrix [Y] :  ',$)
cc       read (input,20)  record
cc 20    format (a120)
cc       next = 1
cc       call gettext (record,answer,next)
cc    end if
cc    call upcase (answer)
cc    if (answer .eq. 'N')  doanalyt = .false.
c
c     reopen the coordinates file and read the first structure
c
      frame = 0
      ixyz = freeunit ()
      xyzfile = filename
      call suffix (xyzfile,'xyz','old')
      open (unit=ixyz,file=xyzfile,status ='old')
      rewind (unit=ixyz)
      call readxyz (ixyz)
c
c     perform dynamic allocation of some local arrays
c     decide the size of sparse Hessian matrix : < 3*n*(3*n-1)/2
c
      allocate (hinit(3,n))
      allocate (hstop(3,n))
      allocate (g(3,n))
      allocate (g0(3,n))
      allocate (hdiag(3,n))
      if (n .le. maxnum)  allocate (nhess(3,n,3,n))
      maxhess0 = 3*n
      maxhess0 = maxhess0 * (maxhess0 -1)
      maxhess0 = maxhess0 / 2
      maxhess  = maxhess0
      do
         allocate (hindex(maxhess), stat=errhindex)
         allocate (h(maxhess)     , stat=errh     )
         if((errhindex .eq. 0) .and. (errh .eq. 0)) exit
         if(errhindex  .eq. 0) deallocate (hindex)
         if(errh       .eq. 0) deallocate (h)

   10    continue
         write (iout,11)  n, maxhess0
   11    format (/,' Select Smaller Size for Sparse Hessian Matrix '
     &             ' for ',i6,' Atoms [ <',i,'=3n(3n-1)/2 ] :  ',$)
         read (input,12,err=10)  maxhess
   12    format (i20)

         if (maxhess .ge. maxhess0) maxhess = maxhess0
         if (maxhess .le. 0       ) maxhess = maxhess0
      end do
c
c     perform analysis for each successive coordinate structure
c
      do while (.not. abort)
         frame = frame + 1
         if (frame .gt. 1) then
            write (iout,120)  frame
  120       format (/,' Analysis for Archive Structure :',8x,i8)
         end if
c
c     get the analytical Hessian matrix elements
c
         identical = .true.
         if (doanalyt) then
            if (verbose) then
               write (iout,130)
  130          format ()
            end if
CC          hesscut = 0.0d0
            call hessian (h,hinit,hstop,hindex,hdiag)
            call hessian (h,hinit,hstop,hindex,hdiag)
            call hessian (h,hinit,hstop,hindex,hdiag)
         end if
c
c     write out the diagonal Hessian elements for each atom
c
         if (doanalyt) then
            if (digits .ge. 8) then
               write (iout,230)
  230          format (/,' Diagonal Hessian Elements for Each Atom :',
     &                    //,6x,'Atom',21x,'X',19x,'Y',19x,'Z',/)
            else if (digits .ge. 6) then
               write (iout,240)
  240          format (/,' Diagonal Hessian Elements for Each Atom :',
     &                    //,6x,'Atom',19x,'X',17x,'Y',17x,'Z',/)
            else
               write (iout,250)
  250          format (/,' Diagonal Hessian Elements for Each Atom :',
     &                    //,6x,'Atom',17x,'X',15x,'Y',15x,'Z',/)
            end if
            do i = 1, n
               if (digits .ge. 8) then
                  write (iout,260)  i,(hdiag(j,i),j=1,3)
  260             format (i10,5x,3f20.8)
               else if (digits .ge. 6) then
                  write (iout,270)  i,(hdiag(j,i),j=1,3)
  270             format (i10,5x,3f18.6)
               else
                  write (iout,280)  i,(hdiag(j,i),j=1,3)
  280             format (i10,5x,3f16.4)
               end if
            end do
         end if
c
c     write out the Hessian trace as sum of diagonal elements
c
         if (doanalyt) then
            sum = 0.0d0
            do i = 1, n
               do j = 1, 3
                  sum = sum + hdiag(j,i)
               end do
            end do
            if (digits .ge. 8) then
               write (iout,290)  sum
  290          format (/,' Sum of Diagonal Hessian Elements :',6x,f20.8)
            else if (digits .ge. 6) then
               write (iout,300)  sum
  300          format (/,' Sum of Diagonal Hessian Elements :',6x,f18.6)
            else
               write (iout,310)  sum
  310          format (/,' Sum of Diagonal Hessian Elements :',6x,f16.4)
            end if
         end if
c
c     write out the full matrix of analytical Hessian elements
c
         if (doanalyt) then
            ihes = freeunit ()
            hessfile = filename(1:leng)//'.hes'
            call version (hessfile,'new')
            open (unit=ihes,file=hessfile,status='new')
            write (iout,360)  hessfile
  360       format (/,' Hessian Sparse Matrix written to File :  ',a40)
            write (ihes,370)
  370       format (/,' Diagonal Hessian Elements  (3 per Atom)',/)
            if (digits .ge. 8) then
               write (ihes,380)  ((hdiag(j,i),j=1,3),i=1,n)
  380          format (4f16.8)
            else if (digits .ge. 6) then
               write (ihes,390)  ((hdiag(j,i),j=1,3),i=1,n)
  390          format (5f14.6)
            else
               write (ihes,400)  ((hdiag(j,i),j=1,3),i=1,n)
  400          format (6f12.4)
            end if
            do i = 1, n
               do j = 1, 3
                  if (hinit(j,i) .le. hstop(j,i)) then
                     write (ihes,410)  i,axis(j)
  410                format (/,' Off-diagonal sparse Hessian'
     &                         ' Indexes/Elements for Atom',i6,1x,a1,/)
                     if (digits .ge. 8) then
                        write (ihes,420)
     &                        (hindex(k), h(k), k=hinit(j,i),hstop(j,i))
  420                   format (i6, f16.8, i6, f16.8, i6, f16.8,
     &                          i6, f16.8, i6, f16.8)
                     else if (digits .ge. 6) then
                        write (ihes,430)
     &                        (hindex(k), h(k), k=hinit(j,i),hstop(j,i))
  430                   format (i6, f14.6, i6, f14.6, i6, f14.6,
     &                          i6, f14.6, i6, f14.6)
                     else
                        write (ihes,440)
     &                        (hindex(k), h(k), k=hinit(j,i),hstop(j,i))
  440                   format (i6, f12.4, i6, f12.4, i6, f12.4,
     &                          i6, f12.4, i6, f12.4)
                     end if
                  end if
               end do
            end do
            close (unit=ihes)
         end if
c
c     attempt to read next structure from the coordinate file
c
         call readxyz (ixyz)
      end do
c
c     perform deallocation of some local arrays
c
      deallocate (hindex)
      deallocate (hinit)
      deallocate (hstop)
      deallocate (h)
      deallocate (g)
      deallocate (g0)
      deallocate (hdiag)
      if (n .le. maxnum)  deallocate (nhess)
c
c     perform any final tasks before program exit
c
      call final
      end program testhesssparse

max_stars_repo_name: htna/HCsbLib

max_issues_repo_name: htna/HCsbLib

max_forks_repo_name: htna/HCsbLib


text:
c
c -----------------------------------------------------------------------
c
       subroutine setIndices(ist,iend,ilo,ihi,
     &                       ishift,level)

       use amr_module
       implicit double precision (a-h,o-z)

       dimension ist(3), iend(3), ishift(3)

c ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
c  setIndices:  for periodicity a region that sticks out is wrapped into
c               another region.
c
c  this is just annoying code this is needed in several places so it became a routine
c
c :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

       ist(1) = ilo
       ist(2) = 0
       ist(3) = iregsz(level)

       iend(1) = -1
       iend(2) = iregsz(level)-1
       iend(3) = ihi

       if (xperdom) then ! regions that stick out of domain get periodically wrapped indices
          ishift(1) = iregsz(level)
          ishift(2) = 0
          ishift(3) = -iregsz(level)
       else   ! no shifting of indices
          ishift(1) = 0
          ishift(2) = 0
          ishift(3) = 0
       endif

       return
       end

max_stars_repo_name: navravi/amrclaw

max_issues_repo_name: navravi/amrclaw

max_forks_repo_name: BrisaDavis/amrclaw


text:
      SUBROUTINE SROTMF (N,SX,INCX,SY,INCY,SPARAM)
C
C     APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX
C
C     (SX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN
C     (DX**T)
C
C     SX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
C     LX = (-INCX)*N, AND SIMILARLY FOR SY USING USING LY AND INCY.
C     WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS..
C
C     SFLAG=-1.E0     SFLAG=0.E0        SFLAG=1.E0     SFLAG=-2.E0
C
C       (SH11  SH12)    (1.E0  SH12)    (SH11  1.E0)    (1.E0  0.E0)
C     H=(          )    (          )    (          )    (          )
C       (SH21  SH22),   (SH21  1.E0),   (-1.E0 SH22),   (0.E0  1.E0).
C     SEE  SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM.
C
      DIMENSION SX(1),SY(1),SPARAM(5)
      DATA ZERO,TWO/0.E0,2.E0/
C
      SFLAG=SPARAM(1)
      IF(N .LE. 0 .OR.(SFLAG+TWO.EQ.ZERO)) GO TO 140
          IF(.NOT.(INCX.EQ.INCY.AND. INCX .GT.0)) GO TO 70
C
               NSTEPS=N*INCX
               IF(SFLAG) 50,10,30
   10          CONTINUE
               SH12=SPARAM(4)
               SH21=SPARAM(3)
                    DO 20 I=1,NSTEPS,INCX
                    W=SX(I)
                    Z=SY(I)
                    SX(I)=W+Z*SH12
                    SY(I)=W*SH21+Z
   20               CONTINUE
               GO TO 140
   30          CONTINUE
               SH11=SPARAM(2)
               SH22=SPARAM(5)
                    DO 40 I=1,NSTEPS,INCX
                    W=SX(I)
                    Z=SY(I)
                    SX(I)=W*SH11+Z
                    SY(I)=-W+SH22*Z
   40               CONTINUE
               GO TO 140
   50          CONTINUE
               SH11=SPARAM(2)
               SH12=SPARAM(4)
               SH21=SPARAM(3)
               SH22=SPARAM(5)
                    DO 60 I=1,NSTEPS,INCX
                    W=SX(I)
                    Z=SY(I)
                    SX(I)=W*SH11+Z*SH12
                    SY(I)=W*SH21+Z*SH22
   60               CONTINUE
               GO TO 140
   70     CONTINUE
          KX=1
          KY=1
          IF(INCX .LT. 0) KX=1+(1-N)*INCX
          IF(INCY .LT. 0) KY=1+(1-N)*INCY
C
          IF(SFLAG)120,80,100
   80     CONTINUE
          SH12=SPARAM(4)
          SH21=SPARAM(3)
               DO 90 I=1,N
               W=SX(KX)
               Z=SY(KY)
               SX(KX)=W+Z*SH12
               SY(KY)=W*SH21+Z
               KX=KX+INCX
               KY=KY+INCY
   90          CONTINUE
          GO TO 140
  100     CONTINUE
          SH11=SPARAM(2)
          SH22=SPARAM(5)
               DO 110 I=1,N
               W=SX(KX)
               Z=SY(KY)
               SX(KX)=W*SH11+Z
               SY(KY)=-W+SH22*Z
               KX=KX+INCX
               KY=KY+INCY
  110          CONTINUE
          GO TO 140
  120     CONTINUE
          SH11=SPARAM(2)
          SH12=SPARAM(4)
          SH21=SPARAM(3)
          SH22=SPARAM(5)
               DO 130 I=1,N
               W=SX(KX)
               Z=SY(KY)
               SX(KX)=W*SH11+Z*SH12
               SY(KY)=W*SH21+Z*SH22
               KX=KX+INCX
               KY=KY+INCY
  130          CONTINUE
  140     CONTINUE
          RETURN
          END

max_stars_repo_name: rozhuk-im/opentoonz

max_issues_repo_name: rozhuk-im/opentoonz

max_forks_repo_name: rozhuk-im/opentoonz


!-------------------------------------------------------------------------------
! Copyright (c) 2016 The University of Tokyo
! This software is released under the MIT License, see LICENSE.txt
!-------------------------------------------------------------------------------
!> This module provides conversion routines between HEC data structure
!! and DOF based sparse matrix structure (CSR/COO)
module m_sparse_matrix_hec
  use hecmw_util
  use m_hecmw_comm_f
  use m_sparse_matrix
  implicit none

  private

  public :: sparse_matrix_hec_init_prof
  public :: sparse_matrix_hec_set_prof
  public :: sparse_matrix_hec_set_conv_ext
  public :: sparse_matrix_hec_set_vals
  public :: sparse_matrix_hec_set_rhs
  public :: sparse_matrix_hec_get_rhs

contains

  !!! public subroutines

  subroutine sparse_matrix_hec_init_prof(spMAT, hecMAT, hecMESH)
    type (sparse_matrix), intent(inout) :: spMAT
    type (hecmwST_matrix), intent(in) :: hecMAT
    type (hecmwST_local_mesh), intent(in) :: hecMESH
    integer(kind=kint) :: ndof, ndof2, N_loc, NL, NU, NZ
    ndof=hecMAT%NDOF; ndof2=ndof*ndof
    N_loc=hecMAT%N*ndof
    if (sparse_matrix_is_sym(spMAT)) then
      NU=hecMAT%indexU(hecMAT%N)
      NZ=hecMAT%N*(ndof2+ndof)/2+NU*ndof2
    else
      NL=hecMAT%indexL(hecMAT%N)
      NU=hecMAT%indexU(hecMAT%N)
      NZ=(hecMAT%N+NU+NL)*ndof2
    endif
    call sparse_matrix_init(spMAT, N_loc, NZ)
    call sparse_matrix_hec_set_conv_ext(spMAT, hecMESH, hecMAT%NDOF)
    spMAT%iterlog = hecMAT%Iarray(21)
    spMAT%timelog = hecMAT%Iarray(22)
    call sparse_matrix_hec_set_prof(spMAT, hecMAT)
  end subroutine sparse_matrix_hec_init_prof

  subroutine sparse_matrix_hec_set_conv_ext(spMAT, hecMESH, ndof)
    type(sparse_matrix), intent(inout) :: spMAT
    type (hecmwST_local_mesh), intent(in) :: hecMESH
    integer(kind=kint), intent(in) :: ndof
    integer(kind=kint) :: i,j,nn_external,id,ierr
    integer(kint)   :: pid,lid,j0
    if (hecMESH%n_neighbor_pe==0) return
    ! create conversion list
    nn_external = hecMESH%n_node - hecMESH%nn_internal
    allocate(spMAT%conv_ext(nn_external*ndof), stat=ierr)
    if (ierr /= 0) then
      write(*,*) " Allocation error, spMAT%conv_ext"
      call hecmw_abort(hecmw_comm_get_comm())
    endif
    spMAT%conv_ext(:) = -1
    do i=1,nn_external
      id = i + hecMESH%nn_internal
      pid = hecMESH%node_ID(id*2)
      lid = hecMESH%node_ID(id*2-1)
      j0 = spMAT%DISPLS(pid+1) + (lid-1)*ndof
      do j=1,ndof
        spMAT%conv_ext((i-1)*ndof+j) = j0+j
      enddo
    enddo
  end subroutine sparse_matrix_hec_set_conv_ext

  subroutine sparse_matrix_hec_set_prof(spMAT, hecMAT)
    type(sparse_matrix), intent(inout) :: spMAT
    type(hecmwST_matrix), intent(in) :: hecMAT
    integer(kind=kint) :: ndof, ndof2
    integer(kind=kint) :: m, i, idof, i0, ii, ls, le, l, j, j0, jdof, jdofs
    !integer(kind=kint) :: offset_l, offset_d, offset_u
    ! CONVERT TO CSR or COO STYLE
    ndof=hecMAT%NDOF; ndof2=ndof*ndof
    m=1
    do i=1,hecMAT%N
      do idof=1,ndof
        i0=spMAT%offset+ndof*(i-1)
        ii=i0+idof
        if (spMAT%type==SPARSE_MATRIX_TYPE_CSR) spMAT%IRN(ii-spMAT%offset)=m
        ! Lower
        if (.not. sparse_matrix_is_sym(spMAT)) then
          ls=hecMAT%indexL(i-1)+1
          le=hecMAT%indexL(i)
          do l=ls,le
            j=hecMAT%itemL(l)
            !if (j <= hecMAT%N) then
            j0=spMAT%offset+ndof*(j-1)
            !else
            !   j0=spMAT%conv_ext(ndof*(j-hecMAT%N))-ndof
            !endif
            !offset_l=ndof2*(l-1)+ndof*(idof-1)
            do jdof=1,ndof
              if (spMAT%type==SPARSE_MATRIX_TYPE_COO) spMAT%IRN(m)=ii
              spMAT%JCN(m)=j0+jdof
              !spMAT%A(m)=hecMAT%AL(offset_l+jdof)
              m=m+1
            enddo
          enddo
        endif
        ! Diag
        !offset_d=ndof2*(i-1)+ndof*(idof-1)
        if (sparse_matrix_is_sym(spMAT)) then; jdofs=idof; else; jdofs=1; endif
        do jdof=jdofs,ndof
          if (spMAT%type==SPARSE_MATRIX_TYPE_COO) spMAT%IRN(m)=ii
          spMAT%JCN(m)=i0+jdof
          !spMAT%A(m)=hecMAT%D(offset_d+jdof)
          m=m+1
        enddo
        ! Upper
        ls=hecMAT%indexU(i-1)+1
        le=hecMAT%indexU(i)
        do l=ls,le
          j=hecMAT%itemU(l)
          if (j <= hecMAT%N) then
            j0=spMAT%offset+ndof*(j-1)
          else
            j0=spMAT%conv_ext(ndof*(j-hecMAT%N))-ndof
            if (sparse_matrix_is_sym(spMAT) .and. j0 < i0) cycle
          endif
          !offset_u=ndof2*(l-1)+ndof*(idof-1)
          do jdof=1,ndof
            if (spMAT%type==SPARSE_MATRIX_TYPE_COO) spMAT%IRN(m)=ii
            spMAT%JCN(m)=j0+jdof
            !spMAT%A(m)=hecMAT%AU(offset_u+jdof)
            m=m+1
          enddo
        enddo
      enddo
    enddo
    if (spMAT%type == SPARSE_MATRIX_TYPE_CSR) spMAT%IRN(ii+1-spMAT%offset)=m
    if (sparse_matrix_is_sym(spMAT) .and. m-1 < spMAT%NZ) spMAT%NZ=m-1
    if (m-1 /= spMAT%NZ) then
      write(*,*) 'ERROR: sparse_matrix_set_ij on rank ',hecmw_comm_get_rank()
      write(*,*) 'm-1 = ',m-1,', NZ=',spMAT%NZ
      stop
    endif
  end subroutine sparse_matrix_hec_set_prof

  subroutine sparse_matrix_hec_set_vals(spMAT, hecMAT)
    type(sparse_matrix), intent(inout) :: spMAT
    type(hecmwST_matrix), intent(in) :: hecMAT
    integer(kind=kint) :: ndof, ndof2
    integer(kind=kint) :: m, i, idof, i0, ii, ls, le, l, j, j0, jdof, jdofs
    integer(kind=kint) :: offset_l, offset_d, offset_u
    ndof=hecMAT%NDOF; ndof2=ndof*ndof
    m=1
    do i=1,hecMAT%N
      do idof=1,ndof
        i0=spMAT%offset+ndof*(i-1)
        ii=i0+idof
        if (spMAT%type == SPARSE_MATRIX_TYPE_CSR) then
          if (spMAT%IRN(ii-spMAT%offset)/=m) stop "ERROR: sparse_matrix_set_a1"
        endif
        ! Lower
        if (.not. sparse_matrix_is_sym(spMAT)) then
          ls=hecMAT%indexL(i-1)+1
          le=hecMAT%indexL(i)
          do l=ls,le
            j=hecMAT%itemL(l)
            !if (j <= hecMAT%N) then
            j0=spMAT%offset+ndof*(j-1)
            !else
            !   j0=spMAT%conv_ext(ndof*(j-hecMAT%N))-ndof
            !endif
            offset_l=ndof2*(l-1)+ndof*(idof-1)
            do jdof=1,ndof
              if (spMAT%type==SPARSE_MATRIX_TYPE_COO) then
                if (spMAT%IRN(m)/=ii) stop "ERROR: sparse_matrix_set_a2"
              endif
              if (spMAT%JCN(m)/=j0+jdof) stop "ERROR: sparse_matrix_set_a3"
              spMAT%A(m)=hecMAT%AL(offset_l+jdof)
              m=m+1
            enddo
          enddo
        endif
        ! Diag
        offset_d=ndof2*(i-1)+ndof*(idof-1)
        if (sparse_matrix_is_sym(spMAT)) then; jdofs=idof; else; jdofs=1; endif
        do jdof=jdofs,ndof
          if (spMAT%type==SPARSE_MATRIX_TYPE_COO) then
            if (spMAT%IRN(m)/=ii) stop "ERROR: sparse_matrix_set_a4"
          endif
          if (spMAT%JCN(m)/=i0+jdof) stop "ERROR: sparse_matrix_set_a5"
          spMAT%A(m)=hecMAT%D(offset_d+jdof)
          m=m+1
        enddo
        ! Upper
        ls=hecMAT%indexU(i-1)+1
        le=hecMAT%indexU(i)
        do l=ls,le
          j=hecMAT%itemU(l)
          if (j <= hecMAT%N) then
            j0=spMAT%offset+ndof*(j-1)
          else
            j0=spMAT%conv_ext(ndof*(j-hecMAT%N))-ndof
            if (sparse_matrix_is_sym(spMAT) .and. j0 < i0) cycle
          endif
          offset_u=ndof2*(l-1)+ndof*(idof-1)
          do jdof=1,ndof
            if (spMAT%type==SPARSE_MATRIX_TYPE_COO) then
              if (spMAT%IRN(m)/=ii) stop "ERROR: sparse_matrix_set_a6"
            endif
            if (spMAT%JCN(m)/=j0+jdof) stop "ERROR: sparse_matrix_set_a7"
            spMAT%A(m)=hecMAT%AU(offset_u+jdof)
            m=m+1
          enddo
        enddo
      enddo
    enddo
    if (spMAT%type == SPARSE_MATRIX_TYPE_CSR) then
      if (spMAT%IRN(ii+1-spMAT%offset)/=m) stop "ERROR: sparse_matrix_set_a8"
    endif
    if (m-1 /= spMAT%NZ) stop "ERROR: sparse_matrix_set_a9"
  end subroutine sparse_matrix_hec_set_vals

  subroutine sparse_matrix_hec_set_rhs(spMAT, hecMAT)
    implicit none
    type (sparse_matrix), intent(inout) :: spMAT
    type (hecmwST_matrix), intent(in) :: hecMAT
    integer(kind=kint) :: ierr,i
    allocate(spMAT%rhs(spMAT%N_loc), stat=ierr)
    if (ierr /= 0) then
      write(*,*) " Allocation error, spMAT%rhs"
      call hecmw_abort(hecmw_comm_get_comm())
    endif
    do i=1,spMAT%N_loc
      spMAT%rhs(i)=hecMAT%b(i)
    enddo
  end subroutine sparse_matrix_hec_set_rhs

  subroutine sparse_matrix_hec_get_rhs(spMAT, hecMAT)
    implicit none
    type (sparse_matrix), intent(inout) :: spMAT
    type (hecmwST_matrix), intent(inout) :: hecMAT
    integer(kind=kint) :: i
    do i=1,spMAT%N_loc
      hecMAT%x(i)=spMAT%rhs(i)
    enddo
    deallocate(spMAT%rhs)
  end subroutine sparse_matrix_hec_get_rhs

end module m_sparse_matrix_hec


text:
Castilian Hall was one of the Cuarto area Dorms. Like other Cuarto buildings, Castilian was not located on Campus like other Freshmen freshman living areas, but was located on Wake Forest Drive close to 8th St..

Castilian had its own Castilian Dining Commons Dining Commons (about 30 seconds to a minute away walking) in addition to the nearby Oxford Circle Dining Commons (about a 5 minute walk). Castilian Hall was divided into two halves: Castilian North and Castilian South. Both featured their own pools, spas, and laundry rooms, with the only difference being the proximity of Castilian South to the Castilian Dining Commons Dining Commons and its game area. Each carpeted and airconditioned unit in Castilian was actually a suite with a living room, one or two bathrooms, and anywhere from two to four bedrooms. Each suite could accommodate up to twelve students and the residence hall houses a total of 450 students.  The pictures below are from a 3 room suite with 2 doubles and 1 single bedroom in Castilian South.
As of the 20102011 school year, the Castilian Dining Commons is nonexistent.
It was easy for Castilian to feel like a really just a big Apartments apartment complex, and that was because it used to be one!  The UC Davis University purchased the thenapartment complex off of someone and outfitted it to be a Dorms residence hall.  You could have seen photos of the old apartmentstyle setup in the main area where the Area Service Desk used to be.  Compared to many of the other dorms, Castilian was fairly quiet and could have been seen as a good place to get schoolwork done.

At the close of the 20102011 school year, Castilian Hall was no longer used for student housing. Student Housing decided that necessary renovations were too costly and will instead sell or redevelop the buildings into private housing, according to the http://www.housing.ucdavis.edu/about/strategic_plan/08_capital_projects.htm strategic plan.

 Photos


text:
submodule(parent1) child1

implicit none

contains

module procedure negate
b = -a
end procedure negate

end submodule child1

max_stars_repo_name: scivision/fortran-submodule

max_issues_repo_name: scivision/fortran-submodule

max_forks_repo_name: scivision/fortran-submodule


text:
      SUBROUTINE read_bcoils
!-----------------------------------------------
!   M o d u l e s
!-----------------------------------------------
      USE bcoils_mod
      USE Vcoilpts
      USE safe_open_mod
      USE biotsavart
      USE mpi_params                                         !mpi stuff
      IMPLICIT NONE
!-----------------------------------------------
!   L o c a l   V a r i a b l e s
!-----------------------------------------------
      INTEGER :: ierr, icoils=21
      INTEGER :: i, n, mbw
      LOGICAL :: lcoil_open
!-----------------------------------------------

      CALL cleanup_biotsavart
      INQUIRE(FILE=TRIM(bcoil_file),NUMBER=icoils,
     1        OPENED=lcoil_open)
      IF (lcoil_open) CLOSE(icoils)
      CALL parse_coils_file(TRIM(bcoil_file))
      mbcoils = SIZE(coil_group) !SAL
      IF (myid .eq. master) THEN
         WRITE(6,'(A)')   '----- COILS Information -----'
         WRITE(6,'(A,A)') '   FILE: ',TRIM(bcoil_file)
         WRITE(6,'(A,I3)')'   Coil Periodicity: ',nfp_bs
         WRITE(6,'(A,I3)')'   Current Systems: ',mbcoils
      END IF
!      CALL safe_open (icoils, ierr, TRIM(bcoil_file), 'old','formatted')
!      IF (ierr .ne. 0) THEN
!         IF (myid .EQ. master) PRINT *,
!     1   'Error opening bcoil_file: ierr = ', ierr,
!     2   ' Setting lbcoil=F'
!!         STOP
!         lbcoil=.FALSE.
!         RETURN
!      END IF

!      ALLOCATE (bcoil_x(ncdim, nwdim1), bcoil_y(ncdim, nwdim1),
!     1          bcoil_z(ncdim, nwdim1), stat=ierr)
!      IF (ierr .ne. 0) STOP 'Allocation error in read_bcoils'

!     READ coil filament coordinates

!      READ (icoils, *) mbcoils
!      IF (mbcoils .gt. ncdim) THEN
!         IF( myid .eq. master ) THEN                         !mpi stuff
!           PRINT *, 'Error: no. of bg coils > ncdim ', mbcoils
!         END IF     !IF( myid .eq. master )                  !mpi stuff
!         STOP
!      END IF

!      DO n=1,mbcoils
!         READ (icoils, *) mbwires(n)
!         mbw = mbwires(n) + 1
!         IF (mbw .gt. nwdim1) THEN
!            IF( myid .eq. master ) THEN                         !mpi stuff
!               PRINT *, 'Error: no. of bg wires > nwdim ', mbw
!            END IF     !IF( myid .eq. master )                  !mpi stuff
!            STOP
!         END IF
!         DO i=1,mbw
!            READ (icoils, *) bcoil_x(n,i), bcoil_y(n,i), bcoil_z(n,i)
!         END DO
!      END DO

!      CLOSE (icoils)

      END SUBROUTINE read_bcoils

max_stars_repo_name: joseluisvelasco/STELLOPT

max_issues_repo_name: joseluisvelasco/STELLOPT

max_forks_repo_name: joseluisvelasco/STELLOPT


! -- Module to manage unit numbers.  Allows for multiple unit numbers
! -- assigned to a single package type, as shown below.
! --    row(i)   cunit(i) iunit(i)%nval   iunit(i)%iunit  iunit(i)%ipos
! --         1      BCF6              1           (1000)            (1)
! --         2       WEL              3 (1001,1003,1005)        (2,5,7)
! --         3       GHB              1           (1002)            (4)
! --         4       EVT              2      (1004,1006)         (6,10)
! --         5       RIV              0               ()             ()
! --       ...

module IunitModule

  use KindModule, only: DP, I4B
  use ConstantsModule, only: LINELENGTH, LENFTYPE
  use SimModule, only: store_error, store_error_filename
  implicit none
  private
  public :: IunitType

  type :: IunitRowType
    integer(I4B) :: nval = 0
    integer(I4B), allocatable, dimension(:) :: iunit                             ! unit numbers for this row
    integer(I4B), allocatable, dimension(:) :: ipos                              ! position in the input files character array
  end type IunitRowType

  type :: IunitType
    integer(I4B) :: niunit = 0
    character(len=LENFTYPE), allocatable, dimension(:) :: cunit
    type(IunitRowType), allocatable, dimension(:) :: iunit
  contains
    procedure :: init
    procedure :: addfile
    procedure :: getunitnumber
  end type IunitType

  contains

  subroutine init(this, niunit, cunit)
! ******************************************************************************
! init -- allocate the cunit and iunit entries of this object, and copy
!   cunit into the object.
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    ! -- dummy
    class(IunitType), intent(inout) :: this
    integer(I4B), intent(in) :: niunit
    character(len=*), dimension(niunit), intent(in) :: cunit
    ! -- local
    integer(I4B) :: i
! ------------------------------------------------------------------------------
    !
    allocate(this%cunit(niunit))
    allocate(this%iunit(niunit))
    this%niunit = niunit
    do i=1,niunit
      this%cunit(i)=cunit(i)
    enddo
    !
    ! -- Return
    return
  end subroutine init

  subroutine addfile(this, ftyp, iunit, ipos, namefilename)
! ******************************************************************************
! addfile -- add an ftyp and unit number.  Find the row for the ftyp and
!            store another iunit value.
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    ! -- modules
    ! -- dummy
    class(IunitType), intent(inout) :: this
    character(len=*), intent(in) :: ftyp
    integer(I4B), intent(in) :: iunit
    integer(I4B), intent(in) :: ipos
    character(len=*), intent(in) :: namefilename
    ! -- local
    character(len=LINELENGTH) :: errmsg
    integer(I4B), allocatable, dimension(:) :: itemp
    integer(I4B) :: i, irow
! ------------------------------------------------------------------------------
    !
    ! -- Find the row containing ftyp
    irow = 0
    do i = 1, this%niunit
      if(this%cunit(i) == ftyp) then
        irow = i
        exit
      endif
    enddo
    if(irow == 0) then
      write(errmsg, '(a,a)') 'Package type not supported: ', ftyp
      call store_error(errmsg)
      call store_error_filename(namefilename, terminate=.TRUE.)
    endif
    !
    ! -- Store the iunit number for this ftyp
    if(this%iunit(irow)%nval == 0) then
      allocate(this%iunit(irow)%iunit(1))
      allocate(this%iunit(irow)%ipos(1))
      this%iunit(irow)%nval=1
    else
      !
      ! -- increase size of iunit
      allocate(itemp(this%iunit(irow)%nval))
      itemp(:) = this%iunit(irow)%iunit(:)
      deallocate(this%iunit(irow)%iunit)
      this%iunit(irow)%nval = this%iunit(irow)%nval + 1
      allocate(this%iunit(irow)%iunit(this%iunit(irow)%nval))
      this%iunit(irow)%iunit(1:this%iunit(irow)%nval - 1) = itemp(:)
      !
      ! -- increase size of ipos
      itemp(:) = this%iunit(irow)%ipos(:)
      deallocate(this%iunit(irow)%ipos)
      allocate(this%iunit(irow)%ipos(this%iunit(irow)%nval))
      this%iunit(irow)%ipos(1:this%iunit(irow)%nval - 1) = itemp(:)
      !
      ! -- cleanup temp
      deallocate(itemp)
    endif
    this%iunit(irow)%iunit(this%iunit(irow)%nval) = iunit
    this%iunit(irow)%ipos(this%iunit(irow)%nval) = ipos
    !
    ! -- Return
    return
  end subroutine

  subroutine getunitnumber(this, ftyp, iunit, iremove)
! ******************************************************************************
! Get the last unit number for type ftyp or return 0 for iunit.  If iremove
! is 1, then remove this unit number.  Similar to a list.pop().
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    class(IunitType), intent(inout) :: this
    character(len=*), intent(in) :: ftyp
    integer(I4B), intent(inout) :: iunit
    integer(I4B), intent(in) :: iremove
    integer(I4B) :: i, irow, nval
! ------------------------------------------------------------------------------
    !
    ! -- Find the row
    irow = 0
    do i = 1, this%niunit
      if(this%cunit(i) == ftyp) then
        irow = i
        exit
      endif
    enddo
    !
    ! -- Find the unit number.
    iunit = 0
    if(irow > 0) then
      nval = this%iunit(irow)%nval
      if(nval > 0) then
        iunit = this%iunit(irow)%iunit(nval)
        if(iremove > 0) then
          this%iunit(irow)%iunit(nval) = 0
          this%iunit(irow)%nval = nval - 1
        endif
      else
        iunit = 0
      endif
    endif
  end subroutine getunitnumber

end module IunitModule


text:
Lorig Kalfayan ran for ASUCD Senate under the Student Focus slate for the Winter 2007 ASUCD Election.  She is a Freshman of an undeclared major, and is a member of Davis Honors Challenge DHC.

Shes Ari Kalfayan Ari Kalfayans little sister, too.


text:
! Test program
program test_table
    implicit none
    integer, parameter :: wp = kind(1.0)
    integer, parameter :: niters_ = 200
    logical :: error_recognised_
    integer :: luout_
    integer :: lutbl_
    integer :: error_
    real(kind=wp) :: expected_oxymin, min_oxymin, max_oxymin
    real(kind=wp) :: expected_time, min_time, max_time

    error_ = 0
    luout_ = 10
    lutbl_ = 11
    open( luout_, file = 'report.out' )
    open( lutbl_, file = 'table.out' )
    write(*,*) 'Running random tests ...'
    call run_ranges
    write(*,*) 'Running specific tests ...'
    call all_tests
    write(luout_,'(a,i5)') 'All tests completed. Number of errors:',error_
    write(*,*) 'Done'
contains

logical function not_equal_abs( x, y, margin )
    real(kind=wp) :: x, y, margin
    not_equal_abs = abs(x-y) > margin
end function not_equal_abs

logical function not_equal_rel( x, y, margin )
    real(kind=wp) :: x, y, margin
    not_equal_rel = abs(x-y) > 0.5 * margin * (abs(x)+abs(y))
end function not_equal_rel

real function random_uniform( xmin, xmax )
    real(kind=wp) :: xmin, xmax
    real(kind=wp) :: r

    call random_number( r )
    random_uniform = xmin + (xmax-xmin) * r
end function random_uniform

real function random_normal( xmean, xstdev )
    real(kind=wp) :: xmean, xstdev
    real(kind=wp) :: r, phi

    call random_number( r )
    call random_number( phi )
    phi = 8.0_wp * atan(1.0_wp) * phi
    r   = sqrt( -2.0_wp * log(r) )
    random_normal = xmean + xstdev * r * cos(phi)
end function random_normal

subroutine recognised_error
    error_recognised_ = .true.
    write(luout_,'(a)') '    Note: error condition correctly recognised'
end subroutine recognised_error

subroutine unexpected_error
    write(luout_,'(a)') '    Note: unexpected error detected'
    error_ = error_ + 1
end subroutine unexpected_error

subroutine all_tests
    use streeter_phelps
    real :: bod, oxy
    real :: k, ka, h, oxysat, dt, oxymin, time

    write(lutbl_,'(100a12)') 'dt','oxy','bod','oxysat','h','k','ka','oxymin','time'

    write(luout_,'(a)') 'Test case: 1'
    dt = 0.1
    oxy = 10
    bod = 1
    oxysat = 10
    h = 10
    k = 0.1
    ka = 1.0
    expected_oxymin = 10.0
    expected_time = 2.0

    call compute_min_oxygen( bod, oxy, k, ka, h, oxysat, dt, oxymin, time )

    write(lutbl_,'(100g12.4)') dt,oxy,bod,oxysat,h,k,ka,oxymin,time
    if ( not_equal_abs(oxymin,expected_oxymin,0.001_wp) ) then
        write(luout_,'(a,g12.4,a,g12.4)') &
            '    Error: oxymin = ',oxymin, ' - expected: ',expected_oxymin
        error_ = error_ + 1
    endif
    if ( not_equal_rel(time,expected_time,0.001_wp) ) then
        write(luout_,'(a,g12.4,a,g12.4)') &
            '    Error: time = ',time, ' - expected: ',expected_time
        error_ = error_ + 1
    endif

    write(luout_,'(a)') 'Test case: 2'
    dt = 0.1
    oxy = 10
    bod = 1
    oxysat = 10
    h = 10
    k = 0.1
    ka = 1.0
    expected_oxymin = 9.630
    expected_time = 9.9

    call compute_min_oxygen( bod, oxy, k, ka, h, oxysat, dt, oxymin, time )

    write(lutbl_,'(100g12.4)') dt,oxy,bod,oxysat,h,k,ka,oxymin,time
    if ( not_equal_abs(oxymin,expected_oxymin,0.001_wp) ) then
        write(luout_,'(a,g12.4,a,g12.4)') &
            '    Error: oxymin = ',oxymin, ' - expected: ',expected_oxymin
        error_ = error_ + 1
    endif
    if ( not_equal_rel(time,expected_time,0.001_wp) ) then
        write(luout_,'(a,g12.4,a,g12.4)') &
            '    Error: time = ',time, ' - expected: ',expected_time
        error_ = error_ + 1
    endif

    write(luout_,'(a)') 'Test case: 3'
    dt = 0.1
    oxy = 10
    bod = 1
    oxysat = 10
    h = 10
    k = 0.1
    ka = 1.0
    expected_oxymin = 9.632
    expected_time = 9.9

    call compute_min_oxygen( bod, oxy, k, ka, h, oxysat, dt, oxymin, time )

    write(lutbl_,'(100g12.4)') dt,oxy,bod,oxysat,h,k,ka,oxymin,time
    if ( not_equal_abs(oxymin,expected_oxymin,0.001_wp) ) then
        write(luout_,'(a,g12.4,a,g12.4)') &
            '    Error: oxymin = ',oxymin, ' - expected: ',expected_oxymin
        error_ = error_ + 1
    endif
    if ( not_equal_rel(time,expected_time,0.001_wp) ) then
        write(luout_,'(a,g12.4,a,g12.4)') &
            '    Error: time = ',time, ' - expected: ',expected_time
        error_ = error_ + 1
    endif

    write(luout_,'(a)') 'Test case: 4'
    dt = 0.1
    oxy = 10
    bod = 1
    oxysat = 10
    h = 10
    k = 0.1
    ka = 1.0
    expected_oxymin = 9.630
    expected_time = 9.8999

    call compute_min_oxygen( bod, oxy, k, ka, h, oxysat, dt, oxymin, time )

    write(lutbl_,'(100g12.4)') dt,oxy,bod,oxysat,h,k,ka,oxymin,time
    if ( not_equal_abs(oxymin,expected_oxymin,0.001_wp) ) then
        write(luout_,'(a,g12.4,a,g12.4)') &
            '    Error: oxymin = ',oxymin, ' - expected: ',expected_oxymin
        error_ = error_ + 1
    endif
    if ( not_equal_rel(time,expected_time,0.001_wp) ) then
        write(luout_,'(a,g12.4,a,g12.4)') &
            '    Error: time = ',time, ' - expected: ',expected_time
        error_ = error_ + 1
    endif

    write(luout_,'(a)') 'Test case: 5'
    dt = 1.0
    oxy = 10
    bod = 1
    oxysat = 10
    h = 10
    k = 0.1
    ka = 1.0
    expected_oxymin = 0.0  ! Undetermined
    expected_time = 0.0  ! Undetermined

    call compute_min_oxygen( bod, oxy, k, ka, h, oxysat, dt, oxymin, time )

    write(lutbl_,'(100g12.4)') dt,oxy,bod,oxysat,h,k,ka,oxymin,time

    write(luout_,'(a)') 'Test case: 6'
    dt = 0.0
    oxy = 0.0  ! Undetermined
    bod = 0.0  ! Undetermined
    oxysat = 0.0  ! Undetermined
    h = 0.0  ! Undetermined
    k = 0.0  ! Undetermined
    ka = 0.0  ! Undetermined
    expected_oxymin = 0.0  ! Undetermined
    expected_time = 0.0  ! Actually ERROR

    call compute_min_oxygen( bod, oxy, k, ka, h, oxysat, dt, oxymin, time )

    write(lutbl_,'(100g12.4)') dt,oxy,bod,oxysat,h,k,ka,oxymin,time
    error_recognised_ = .false.
    if ( time == -999.0 ) then
        call recognised_error
    endif

    if ( .not. error_recognised_ ) then
        write(luout_,'(a)') '    Failure: error not recognised'
    endif

    write(luout_,'(a)') 'Test case: 7'
    dt = 1.0
    oxy = 0.
    bod = 10
    oxysat = 10
    h = 10
    k = 0.1
    ka = 1.0
    expected_oxymin = 0.0  ! Undetermined
    expected_time = 0.0  ! Undetermined

    call compute_min_oxygen( bod, oxy, k, ka, h, oxysat, dt, oxymin, time )

    write(lutbl_,'(100g12.4)') dt,oxy,bod,oxysat,h,k,ka,oxymin,time
end subroutine all_tests

subroutine run_ranges
    use streeter_phelps
    real :: bod, oxy
    real :: k, ka, h, oxysat, dt, oxymin, time

    integer :: i_
    real(wp) :: min_oxymin = huge(1.0_wp), max_oxymin = -huge(1.0_wp)
    real(wp) :: min_time = huge(1.0_wp), max_time = -huge(1.0_wp)
    real(wp) :: min_dt = huge(1.0_wp), max_dt = -huge(1.0_wp)
    real(wp) :: min_oxy = huge(1.0_wp), max_oxy = -huge(1.0_wp)
    real(wp) :: min_bod = huge(1.0_wp), max_bod = -huge(1.0_wp)
    real(wp) :: min_oxysat = huge(1.0_wp), max_oxysat = -huge(1.0_wp)
    real(wp) :: min_h = huge(1.0_wp), max_h = -huge(1.0_wp)
    real(wp) :: min_k = huge(1.0_wp), max_k = -huge(1.0_wp)
    real(wp) :: min_ka = huge(1.0_wp), max_ka = -huge(1.0_wp)

    write(lutbl_,'(100a12)') &
'dt','oxy','bod','oxysat','h','k','ka','oxymin','time'

    do i_ = 1,niters_
        dt = 0.1
        if ( dt < min_dt ) min_dt = dt
        if ( dt > max_dt ) max_dt = dt
        oxy = random_uniform(9.0,11.0)
        if ( oxy < min_oxy ) min_oxy = oxy
        if ( oxy > max_oxy ) max_oxy = oxy
        bod = random_uniform(7.5,12.5)
        if ( bod < min_bod ) min_bod = bod
        if ( bod > max_bod ) max_bod = bod
        oxysat = random_uniform(7.5,12.5)
        if ( oxysat < min_oxysat ) min_oxysat = oxysat
        if ( oxysat > max_oxysat ) max_oxysat = oxysat
        h = 10.0
        if ( h < min_h ) min_h = h
        if ( h > max_h ) max_h = h
        k = random_uniform(0.3,0.7)
        if ( k < min_k ) min_k = k
        if ( k > max_k ) max_k = k
        ka = random_uniform(0.3,0.7)
        if ( ka < min_ka ) min_ka = ka
        if ( ka > max_ka ) max_ka = ka

            call compute_min_oxygen( bod, oxy, k, ka, h, oxysat, dt, oxymin, time )
            if ( time == -999.0 ) then
        call recognised_error
    endif
        if ( oxymin < min_oxymin ) min_oxymin = oxymin
        if ( oxymin > max_oxymin ) max_oxymin = oxymin
        if ( time < min_time ) min_time = time
        if ( time > max_time ) max_time = time
            call compute_min_oxygen( bod, oxy, k, ka, h, oxysat, dt, oxymin, time )

        write(lutbl_,'(100g12.4)') &
dt,oxy,bod,oxysat,h,k,ka,oxymin,time
    enddo
    write(luout_,'(a)') 'Overview of iterations:'
    write(luout_,'(a20,2g12.4)') 'dt', min_dt, max_dt
    write(luout_,'(a20,2g12.4)') 'oxy', min_oxy, max_oxy
    write(luout_,'(a20,2g12.4)') 'bod', min_bod, max_bod
    write(luout_,'(a20,2g12.4)') 'oxysat', min_oxysat, max_oxysat
    write(luout_,'(a20,2g12.4)') 'h', min_h, max_h
    write(luout_,'(a20,2g12.4)') 'k', min_k, max_k
    write(luout_,'(a20,2g12.4)') 'ka', min_ka, max_ka
    write(luout_,'(a20,2g12.4)') 'oxymin', min_oxymin, max_oxymin
    write(luout_,'(a20,2g12.4)') 'time', min_time, max_time

end subroutine run_ranges

end program test_table

max_stars_repo_name: TerribleDev/Fortran-docker-mvc

max_issues_repo_name: TerribleDev/Fortran-docker-mvc

max_forks_repo_name: TerribleDev/Fortran-docker-mvc


text:
cdis    Forecast Systems Laboratory
cdis    NOAA/OAR/ERL/FSL
cdis    325 Broadway
cdis    Boulder, CO     80303
cdis
cdis    Forecast Research Division
cdis    Local Analysis and Prediction Branch
cdis    LAPS
cdis
cdis    This software and its documentation are in the public domain and
cdis    are furnished "as is."  The United States government, its
cdis    instrumentalities, officers, employees, and agents make no
cdis    warranty, express or implied, as to the usefulness of the software
cdis    and documentation for any purpose.  They assume no responsibility
cdis    (1) for the use of the software and documentation; or (2) to provide
cdis     technical support to users.
cdis
cdis    Permission to use, copy, modify, and distribute this software is
cdis    hereby granted, provided that the entire disclaimer notice appears
cdis    in all copies.  All modifications to this software must be clearly
cdis    documented, and are solely the responsibility of the agent making
cdis    the modifications.  If significant modifications or enhancements
cdis    are made to this software, the FSL Software Policy Manager
cdis    (softwaremgr@fsl.noaa.gov) should be notified.
cdis
cdis
cdis
cdis
cdis
cdis
cdis
        function make_rh (p,t,ssh,t_ref)

c       this function is designed to compute (rh) from basic variables
c       p (mb), t(c) and q (g/kg) to give rh in fraction.  The reference
c       temperature t_ref (c) is used to describe the temperature at which
c       the liquid and ice phase change occurs.

c       Dan Birkenheuer    14 May 1993

        implicit none

        real p  !ambient pressure (mb)
        real t   !ambient temp (c)
        real ssh  !specific humidity in g/kg
        real t_ref  !phase reference temp (c)
        real make_rh  !routine output (fraction)
        external eslo
        external esice
        external es
        integer istatus
        real rmd
        real eslo  !function type
        real esice !function type
        real es    !function type
        real esat   !saturation vapor pressure of the environment

        real ew ! vapor pressure of the environment

        real mw_air !molecular weight of dry air
        real mw_vap  !molecular weight of water

        data mw_vap /18.0152/
        data mw_air /28.966/

        if (ssh .eq. 0.0) then   !the obvious limitation
                make_rh = 0.0
                return
        endif

c       first compute the saturation  vapor pressure of water

        if(t_ref .lt.-132.) t_ref = -132.  ! limit t_ref

        if (t .gt. t_ref .and. t .ge. -132. ) then ! liquid phase
c                                               eslo approx
                esat = eslo (t)

        elseif (t .le. t_ref) then ! assume ice phase
                esat = esice (t)

        else ! situation not covered (impossible)

           write(6,*) 'Warning.. t and t_ref conflict, missing data
     1 returned'
           call get_r_missing_data(rmd, istatus)

           esat = rmd

        endif

c       now derive ambient vap pres from ssh from ideal gas law and
c       definition of sh = mv/(mv+ma)

        ew = p/ ( ( (mw_vap/ssh*1000. - mw_vap)/ mw_air) + 1. )

c       now compute the relative humidity using the partial vapor
c       by simple ratio.

        make_rh = ew /esat  !  units are fraction (dimensionless)

        return
        end

max_stars_repo_name: maxinye/laps-mirror

max_stars_repo_licenses: Intel Unlicense OLDAP-2.2.1 NetCDF

max_issues_repo_name: longwosion/laps-mirror

max_issues_repo_licenses: Intel NetCDF OLDAP-2.2.1 Unlicense

max_forks_repo_name: longwosion/laps-mirror

max_forks_repo_licenses: Intel NetCDF OLDAP-2.2.1 Unlicense


text:
      integer nwz
      common/nwz/nwz

max_stars_repo_name: tmartini/JHUGen

max_issues_repo_name: tmartini/JHUGen

max_forks_repo_name: tmartini/JHUGen


text:
c**********************************************************************
c		      SWIFT_SYMBA5_J.F
c**********************************************************************
c
c                 To run, need 2 input files. The code prompts for
c                 the file names, but examples are :
c
c                   parameter file like       param.in
c		    planet file like          pl.in
c
c  NOTE:  No test particles in this code and the massive bodies
c         are dimensioned at NTPMAX
c
c  This version inputs/outputs Jacobi coords and orbital elements.
c
c Authors: Man Hoi Lee
c Date:    1/20/05
c Last revision:

      include 'swift.inc'

      real*8 mass(NTPMAX),j2rp2,j4rp4
      real*8 xj(NTPMAX),yj(NTPMAX),zj(NTPMAX)
      real*8 vxj(NTPMAX),vyj(NTPMAX),vzj(NTPMAX)

      real*8 xh(NTPMAX),yh(NTPMAX),zh(NTPMAX)
      real*8 vxh(NTPMAX),vyh(NTPMAX),vzh(NTPMAX)

      real*8 xjt(1),yjt(1),zjt(1)       ! Dummy for the io
      real*8 vxjt(1),vyjt(1),vzjt(1)
      integer ntp,istat(1,NSTAT)

      integer nbod,i1st,i,nbodm,nbodo
      integer iflgchk,iub,iuj,iud,iue,ium

      real*8 t0,tstop,dt,dtout,dtdump
      real*8 t,tout,tdump,tfrac,eoff
      real*8 rpl(NTPMAX),rhill(NTPMAX)

      real*8 rmin,rmax,rmaxu,qmin,mtiny
      logical*2 lclose
      integer isenc,ihills
      integer mergelst(2,NTPMAX),mergecnt
      integer*2 iecnt(NTPMAX)

      character*80 outfile,inparfile,inplfile,fopenstat

c-----
c...  Executable code

      ntp = 0

c...  print version number
      call util_version

c Get data for the run and the test particles
      write(*,*) 'Enter name of parameter data file : '
      read(*,999) inparfile
      call io_init_param(inparfile,t0,tstop,dt,dtout,dtdump,
     &     iflgchk,rmin,rmax,rmaxu,qmin,lclose,outfile,fopenstat)

c Prompt and read name of planet data file
      write(*,*) ' '
      write(*,*) 'Enter name of planet data file : '
      read(*,999) inplfile
 999  format(a)
      call io_init_pl_symba(inplfile,lclose,iflgchk,nbod,mass,
     &     xj,yj,zj,vxj,vyj,vzj,rpl,rhill,j2rp2,j4rp4)

      write(*,*) 'Enter the smallest mass to self gravitate :'
      read(*,*) mtiny
      write(*,*) ' mtiny = ',mtiny

c Initialize initial time and times for first output and first dump
      t = t0
      tout = t0 + dtout
      tdump = t0 + dtdump

      iub = 20
      iuj = 30
      iud = 40
      iue = 60
      ium = 21

c...    Do the initial io write
      if(btest(iflgchk,1))  then ! bit 1 is set
         call io_write_frame_j(t0,nbod,ntp,mass,xj,yj,zj,vxj,vyj,vzj,
     &        xjt,yjt,zjt,vxjt,vyjt,vzjt,istat,outfile,iub,fopenstat)
         call io_write_mass(t0,nbod,mass,outfile,ium,fopenstat)
      endif
      if(btest(iflgchk,2))  then ! bit 2 is set
         eoff = 0.0d0
         call coord_j2h(nbod,mass,xj,yj,zj,vxj,vyj,vzj,xh,yh,zh,
     &        vxh,vyh,vzh)
         call anal_energy_write(t0,nbod,mass,j2rp2,j4rp4,xh,yh,zh,vxh,
     &        vyh,vzh,iue,fopenstat,eoff)
      endif

c...  must initize discard io routine
      if(btest(iflgchk,4))  then ! bit 4 is set
         call io_discard_mass(0,t,0,mass(1),rpl(1),xj(1),yj(1),zj(1),
     &        vxj(1),vyj(1),vzj(1),iud,-1,fopenstat)
      endif

c...  Calculate the location of the last massive particle
      call symba5_nbodm(nbod,mass,mtiny,nbodm)

      ihills = 0
      i1st = 0
c***************here's the big loop *************************************
      write(*,*) ' ************** MAIN LOOP ****************** '

      do while ( (t .le. tstop) .and. (nbod.gt.1) )

         i1st = 0

         call coord_j2h(nbod,mass,xj,yj,zj,vxj,vyj,vzj,xh,yh,zh,
     &        vxh,vyh,vzh)

         call symba5_step_pl(i1st,t,nbod,nbodm,mass,j2rp2,j4rp4,
     &        xh,yh,zh,vxh,vyh,vzh,dt,lclose,rpl,isenc,
     &        mergelst,mergecnt,iecnt,eoff,rhill,mtiny)

         call coord_h2j(nbod,mass,xh,yh,zh,vxh,vyh,vzh,xj,yj,zj,
     &        vxj,vyj,vzj)

         t = t + dt

         if(btest(iflgchk,4))  then ! bit 4 is set
            nbodo = nbod
            call discard_massive5(t,dt,nbod,mass,xj,yj,zj,
     &           vxj,vyj,vzj,rmin,rmax,rmaxu,qmin,lclose,
     &           rpl,rhill,isenc,mergelst,mergecnt,
     &           iecnt,eoff,i1st)
            if(nbodo.ne.nbod) then
               call symba5_nbodm(nbod,mass,mtiny,nbodm)
            endif
         endif

c if it is time, output orb. elements,
         if(t .ge. tout) then

            if(btest(iflgchk,1))  then ! bit 1 is set
               call  io_write_frame_j(t,nbod,ntp,mass,xj,yj,zj,vxj,
     &              vyj,vzj,xjt,yjt,zjt,vxjt,vyjt,vzjt,istat,outfile,
     &              iub,fopenstat)
               call io_write_mass(t,nbod,mass,outfile,ium,fopenstat)
            endif

	    tout = tout + dtout
         endif

c If it is time, do a dump
         if(t.ge.tdump) then

            tfrac = (t-t0)/(tstop-t0)
            write(*,998) t,tfrac,nbod
 998        format(' Time = ',1p1e12.5,': fraction done = ',0pf5.3,
     &            ': Number of bodies =',i4)
            call io_dump_pl_symba('dump_pl.dat',nbod,mass,xj,yj,zj,
     &           vxj,vyj,vzj,lclose,iflgchk,rpl,rhill,j2rp2,j4rp4)
            call io_dump_param('dump_param.dat',t,tstop,dt,dtout,
     &           dtdump,iflgchk,rmin,rmax,rmaxu,qmin,lclose,outfile)
            tdump = tdump + dtdump

            if(btest(iflgchk,2))  then ! bit 2 is set
               call coord_j2h(nbod,mass,xj,yj,zj,vxj,vyj,vzj,xh,yh,zh,
     &              vxh,vyh,vzh)
               call anal_energy_write(t,nbod,mass,j2rp2,j4rp4,
     &              xh,yh,zh,vxh,vyh,vzh,iue,fopenstat,eoff)
            endif

	  endif

	enddo
c********** end of the big loop from time 't0' to time 'tstop'

c Do a final dump for possible resumption later

	call io_dump_pl_symba('dump_pl.dat',nbod,mass,xj,yj,zj,
     &            vxj,vyj,vzj,lclose,iflgchk,rpl,rhill,j2rp2,j4rp4)
	call io_dump_param('dump_param.dat',t,tstop,dt,dtout,
     &         dtdump,iflgchk,rmin,rmax,rmaxu,qmin,lclose,outfile)

        call util_exit(0)
        end    ! swift_symba5_j_migrate6.f
c---------------------------------------------------------------------

c*************************************************************************
c                            IO_WRITE_FRAME_J
c*************************************************************************
c write out a whole frame to an real*4 binary file.
c both massive and test particles
c
c             Input:
c                 time          ==>  current time (real scalar)
c                 nbod          ==>  number of massive bodies (int scalar)
c                 ntp            ==>  number of massive bodies (int scalar)
c                 mass          ==>  mass of bodies (real array)
c                 xj,yj,zj      ==>  current position in Jacobi coord
c                                    (real arrays)
c                 vxj,vyj,vzj   ==>  current velocity in Jacobi coord
c                                    (real arrays)
c                 xjt,yjt,zjt    ==>  current part position in Jacobi coord
c                                      (real arrays)
c                 vxjt,vyjt,vzjt ==>  current velocity in Jacobi coord
c                                        (real arrays)
c                 istat           ==>  status of the test paricles
c                                      (2d integer array)
c                                      istat(i,1) = 0 ==> active:  = 1 not
c                                      istat(i,2) = -1 ==> Danby did not work
c                 oname           ==> output file name (character string)
c                 iu              ==> unit number to write to
c                 fopenstat       ==>  The status flag for the open
c                                      statements of the output files.
c                                          (character*80)
c
c
c Remarks: Based on io_write_frame
c Authors:  Hal Levison
c Date:    2/22/94
c Last revision:

      subroutine io_write_frame_j(time,nbod,ntp,mass,xj,yj,zj,vxj,
     &           vyj,vzj,xjt,yjt,zjt,vxjt,vyjt,vzjt,istat,oname,
     &           iu,fopenstat)

      include 'swift.inc'
      include '../io/io.inc'

c...  Inputs:
      integer nbod,ntp,iu
      real*8 mass(nbod),time
      integer istat(1,NSTAT)
      real*8 xj(nbod),yj(nbod),zj(nbod)
      real*8 vxj(nbod),vyj(nbod),vzj(nbod)
      real*8 xjt(ntp),yjt(ntp),zjt(ntp)
      real*8 vxjt(ntp),vyjt(ntp),vzjt(ntp)
      character*80 oname,fopenstat

c...  Internals
      integer i,id
      integer ialpha,ierr
      real*8 a,e,inc,capom,omega,capm
      real*8 gm
      integer i1st    ! =0 first time through; =1 after
      data i1st/0/
      save i1st

c----
c...  Executable code

c...  if first time through open file
      if(i1st.eq.0) then
         call io_open(iu,oname,fopenstat,'UNFORMATTED',ierr)
         if(ierr.ne.0) then
           write(*,*) ' SWIFT ERROR: in io_write_frame: '
           write(*,*) '     Could not open binary output file:'
           call util_exit(1)
         endif
         i1st = 1
      else
        call io_open(iu,oname,'append','UNFORMATTED',ierr)
      endif

      call io_write_hdr_r(iu,time,nbod,ntp,istat)

c...  write out planets
      gm = mass(1)
      do i=2,nbod
         gm = gm + mass(i)
         id = -1*i
 	 call orbel_xv2el(xj(i),yj(i),zj(i),vxj(i),vyj(i),vzj(i),gm,
     &          ialpha,a,e,inc,capom,omega,capm)
         call io_write_line_r(iu,id,a,e,inc,capom,omega,capm)
      enddo

c...  write out test particles
      gm = mass(1)
      do i=1,ntp
         if(istat(i,1).eq.0) then
            call orbel_xv2el(xjt(i),yjt(i),zjt(i),vxjt(i),vyjt(i),
     &          vzjt(i),gm,ialpha,a,e,inc,capom,omega,capm)
            call io_write_line_r(iu,i,a,e,inc,capom,omega,capm)
         endif
      enddo

      close(iu)
      return
      end      ! io_write_frame_j
c----------------------------------------------------------------------

max_stars_repo_name: Simske/exostriker


text:
C  =====================================================================
C  pgm: SH2SKP .. Get next char that is not the given char (skp gvn chr)
C
C  use:     CALL SH2SKP(KHAR,KHPOS,CHR)
C
C  i/o: KHAR ...... last buffer char obtained - CHAR*1
C  i/o: KHPOS ..... last char loc: 2=eol,1=err-eol,0=eof,neg=err - INT
C   in: CHR ....... given character to be skipped - CHAR*1
C
C  rqd: SHGETK
C  =====================================================================
      SUBROUTINE SH2SKP(KHAR,KHPOS,CHR)

      EXTERNAL       SHGETK

      CHARACTER*1    KHAR,CHR
      INTEGER        KHPOS
C
C    ================================= RCS keyword statements ==========
      CHARACTER*68     RCSKW1,RCSKW2
      DATA             RCSKW1,RCSKW2 /                                 '
     .$Source: /fs/hseb/ob5/rfc/ofs/src/shefpars_driv/RCS/sh2skp.f,v $
     . $',                                                             '
     .$Id: sh2skp.f,v 1.1 1995/11/29 22:20:48 dws Exp $
     . $' /
C    ===================================================================
C

C                   Loop until next char is not the given char (or eol)

   10   IF (KHAR.NE.CHR .OR. KHPOS.LE.2) GOTO 20
          CALL SHGETK(KHAR,KHPOS)
          GOTO 10
   20   CONTINUE

      RETURN
      END

max_stars_repo_name: oxelson/gempak

max_issues_repo_name: oxelson/gempak

max_forks_repo_name: oxelson/gempak


text:
	SUBROUTINE SF_CCLP  ( filnam, prmfil, iflsrc, maxstn, maxtim,
     +			      stmflg, isffln, nparm,  parms,  pkflg,
     +			      iret )
C************************************************************************
C* SF_CCLP								*
C*									*
C* This subroutine creates a new climate surface data file.  The	*
C* file will have times stored as columns of the DM file and stations	*
C* as rows.								*
C*									*
C* The contents of the file named in PRMFIL will determine the 		*
C* parameters to be contained in the data set and the packing, if any,	*
C* to be used.  PKFLG is set on output if the data are to be packed.	*
C* All data packing and unpacking will be done internally.  This	*
C* subroutine is identical to SF_CCLF except that the packing 		*
C* information is read from a file in this subroutine.  The data	*
C* packing file is described in the introduction to this chapter.	*
C*									*
C* If the station time flag is set, a single word is allocated with 	*
C* each data report to store the report time (HHMM).  This time 	*
C* should be sent to SF_WDAT.  						*
C*									*
C* If the file cannot be created, error messages will be written.	*
C*									*
C* The data source values are parameters in GEMPRM.PRM .	*
C* These are not currently used by any GEMPAK program.  Current		*
C* definitions include:							*
C*      MFUNKN        unknown						*
C*      MFAIRW        airways surface observation			*
C*      MFMETR        Metar report					*
C*      MFSHIP        ship report					*
C*      MFBUOY        buoy report					*
C*      MFSYNP        synoptic report					*
C*									*
C* SF_CCLP  ( FILNAM, PRMFIL, IFLSRC, MAXSTN, MAXTIM, STMFLG, ISFFLN, 	*
C*            NPARM,  PARMS,  PKFLG,  IRET )				*
C*									*
C* Input parameters:							*
C*	FILNAM		CHAR*		Surface file name		*
C*	PRMFIL		CHAR*		Parameter packing file name 	*
C*	IFLSRC		INTEGER		Data source 			*
C*	MAXSTN		INTEGER	 	Maximum number of stations 	*
C*	MAXTIM		INTEGER  	Maximum number of times 	*
C*	STMFLG		LOGICAL		Station time flag		*
C*									*
C* Output parameters:							*
C*	ISFFLN		INTEGER		Surface file number		*
C*	NPARM		INTEGER		Number of parameters 		*
C*	PARMS (NPARM)	CHAR*4		Parameter names 		*
C*	PKFLG		LOGICAL		Parameter packing flag		*
C*	IRET		INTEGER		Return code			*
C*				    	  0 = normal return		*
C*				   	 -1 = file not created		*
C**									*
C* Log:									*
C* M. desJardins/GSFC	 3/90						*
C* S. Jacobs/NCEP	 7/96	Updated documentation			*
C************************************************************************
	INCLUDE		'GEMPRM.PRM'
	INCLUDE		'GMBDTA.CMN'
	INCLUDE 	'sfcmn.cmn'
C*
	CHARACTER*(*) 	filnam, prmfil, parms (*)
	LOGICAL 	pkflg, stmflg
C*
	INTEGER		iscale (MMPARM), iofset (MMPARM), ibits (MMPARM)
C------------------------------------------------------------------------
	iret = 0
C
C*	Get parameter information.
C
	CALL DP_FILE  ( prmfil, nparm, parms, iscale, iofset, ibits,
     +			pkflg, iret)
	IF  ( iret .ne. 0 )  THEN
	    CALL ER_WMSG  ( 'DP', iret, prmfil, ier )
	    iret = -1
	    CALL ER_WMSG  ( 'SF', iret, filnam, ier )
	    RETURN
	END IF
C
C*	Create the file.
C
	CALL SF_CCLF  ( filnam, iflsrc, nparm,  parms, maxstn, maxtim,
     +			pkflg,  iscale, iofset, ibits, stmflg, isffln,
     +			iret )
C*
	RETURN
	END


text:
 A Little History
What is usually referred to as Thai cuisine evolved in the Central regions of Thailand. Rice, fish, and vegetables, flavored with garlic, black pepper, and fish sauce, along with fresh fruit, comprised the basic diet of Sukhothai, a Thai empire founded in 1238 (the name Sukhothai means Dawn of Happiness). For 120 years, Sukhothai was the capital of a Thai kingdom that was considerably larger than Thailand is now.  A total of eight kings ruled Sukhothai before 1365 when it was degraded into a vassal state of Ayutthaya. With new politics came new food  the almost essential chili pepper was introduced, as was coriander, lime and tomato  perhaps making their way from South America to Thailand via the Portuguese.  Other influences came from India, Japan, Persia, and China.

In Davis, The Paragon was the first establishment to offer Thai food, but it was only available on weekdays when Sophia managed the bars kitchen. Though The Paragon is long gone, Sophias culinary legacy continues with Sophias Thai Kitchen.

 So Youre Hungry for Thai Food in Davis
Davis has a Plethora vs. Dearth in Davis surprising number of Thai restaurants for its size.  Despite mixed reviews for each of its Thai restaurants, the Thai food found in Davis is consistently very good, unlike other genres of food to be had.  Each of the restaurants below offers a dish or amenity uniquely good (such as free refills on Thai Iced Tea, excellent Pad Thai, or friendly and quick service) and each has a drawback (long lines, slow service, starchy food).

Chopsticks are not typically used for most dishes in Thailand, so dont be surprised to when you get a funny look upon requesting them. However, in Thailand, it is perfectly fine to use chopsticks for dishes with long noodles. For example, Pad Thai has long and thin rice noodle which is somewhat suitable to be eaten with chopsticks. In contrast, Pad See Ew uses thick and fat noodle (Chow Fun in Chinese) and could be eaten with a fork or a spoon in combination. The Thais prefer to use spoon with rice as their rice is flakier and softer than the Japanese counterpart.

 The Spice Tray

Thais are big on doctoring their own food, especially with regard to spice.  Most restaurants in Thailand will serve their dishes relatively mild, but will automatically provide a small tray of spicy foods spicy condiments to add to the dish.  Thai restaurants in the U.S. (including those in Davis) dont provide the spice tray automatically, but they almost always have them, and will happily bring one out if you ask.  Common condiments on a spice tray include sliced chilies in vinegar or fish sauce, a sour chiligarlic sauce, and coarsely ground dried chilies (when you just need a direct blast of heat).  So next time you ask for extra spicy at a Thai restaurant in Davis and get a mere medium instead, ask your waiter for the spice tray.

 Restaurants
KetMoRee
Pricing: High (~14/Entree); Pad Thai starts at $11. Now Featuring Lunch Specials @ $7.95.
Spiciness:
Quality:
Service:
Refills: Yes on Sodas and Thai Iced Teas
Misc: The remodeled and moved successor to 2K Thai Food

Open Rice Kitchen

Taste of Thai
Pricing: Lunches are $6.95/$8.95/$9.95 (vegetarian,chicken, beef, or pork/shrimp, squid/seafood combo) including soup or salad, Dinner $8.95/$10.95/$12.95
Spiciness:
Quality:
Service:
Refills: Iced Tea (rest unknown).

Sophias Thai Kitchen
Pricing:  (9/person); Pad Thai is $8.95
Spiciness:
Quality:  Debatable.
Service:  Super slow, but fun environment.
Refills:  Yes on Thai Iced Tea
Misc:  Free refills on Thai iced tea; Outdoor Seating outdoor heated and covered patio; long wait is typical, but you can hang out at the bar.

Thai Canteen
Pricing: Same menu all day long $6.95 to $8.95
Spiciness: mild to Thai hot
Quality:
Service: selfserve restaurant similar to fast food Style
Refills:
Misc: Opened in November 2010, in the space that was formerly occupied by Crepe House Uni Crepe House Uni at 117 E. Street.

Kow Thai Restaurant
Pricing:
Spiciness:
Quality:
Service:
Refills:
Misc:

Thai Nakorn
Pricing:  Lower (9/person); Pad Thai is $6.95
Spiciness:
Quality:Very Good
Service:Very Good
Refills: Unknown
Misc: Menu available on DavisWiki, close to movie theater

Thai Recipes
Pricing:  Moderate (~11/person); Pad Thai is $8.95
Spiciness:  Adjustable
Quality: Considered by some to be the best
Service:
Refills: Yes on fountain drinks; no on Thai Iced Tea
Misc:  Very vegetarianfriendly

 Former Restaurants

Thai Bistro
Pricing:  Moderate (~10/person); Pad Thai $7.95; Lunch specials are especially a good deal; salad, rice (unless ordering a noodle item), starting at $5.95 to $6.95
Spiciness:  Adjustable
Quality:  Very Good.
Service:  Moderate.
Refills: Unknown
Misc: Voted Thai Bistro as Best Thai food in Davis in 2004.  Towards the Upscale restaurants classy end of the scale. Outdoor seating, and duck dishes are always available.  Has unusual dishes not found elsewhere.

Photos of yummy food

20060916 11:36:42 nbsp Can we not list the price for Pad Thai, please? I understand its popular and all, but there is more to experiencing Thai food than just eating Pad Thai... This would be like having a page on American food and notating the price of a hamburger. Users/PaulAmnuaypayoat
  I think that including the price of Pad Thai is a good indicator of how the pricing for the rest of the menu will follow. I would say that having the price of a hamburger is a good idea, too, since it would set a metric regarding how the restaurant prices their food, and can be used as a standard for comparison to like restaurants. Users/JoePomidor
     I agree.  Im curious as to what the price of Thai hamburgers are.  ;)

I love Thai food and in all truth, I really like most of the Thai restaurants in town. But, if I must choose... Thai Nakorn is my favorite.  The food is consistently tasty with lots of good options (and good veggie options).  The service is friendly and they welcome dogs on the patio.  They also have some dishes that lean more towards Chinese, so if youre not sure what you want (or if you have a mixed party that cant make up its mind), its a good choice.  My second favorite is Thai Bistro. Hard to say why, other than the generic: quality ingredients that taste good. Try the sweet and sour chicken with mango. (Heres a hint: its not that deep batter fried stuff with gloppy pink sauce). And they also get extra points for the nice outdoor patio where you can bring your dog. Thai Dynamite is a place I need to frequent more often; just cant seem to make it over there for dinner (I wish they were open for lunch!).  After that, I like the way that Thai Recipes always asks if you want your tofu fried or soft, and  Sophias Thai Kitchen has that closetocampus advantage, so its probably my favorite for lunch.  So, thats my preference for now, with the right to change my mind in the future! Users/CovertProfessor

20100701 16:21:13 nbsp I groaned when I saw this, but there is yet another Thai place going to open in Davis. Where the Crepe place on E St was. I saw the license posted in the windwo today (http://twitpic.com/21jsm1). Eight Thai places, seven of which are all in 5 minutes walk of each other. Users/KeithBradnam
  Thai Canteen. Users/hankim

20100701 16:43:31 nbsp A Google map showing all eight Thai restaurants in Davis: http://maps.google.com/maps/ms?ieUTF8&hlen&msa0&ll38.544339,121.729975&spn0.072568,0.132093&z14&msid110173474194569111691.00048a5bdd402f73bcde7 Users/KeithBradnam