text:
! <cstatm.f90 - A component of the City-scale
!                 Chemistry Transport Model EPISODE-CityChem>
!*****************************************************************************!
!*
!* EPISODE - An urban-scale air quality model
!* ==========================================
!* Copyright (C) 2018  NILU - Norwegian Institute for Air Research
!*                     Instituttveien 18
!*                     PO Box 100
!*                     NO-2027 Kjeller
!*                     Norway
!*
!*                     Contact persons: Gabriela Sousa Santos - gss@nilu.no
!*                                      Paul Hamer - pdh@nilu.no
!*
!* Unless explicitly acquired and licensed from Licensor under another license,
!* the contents of this file are subject to the Reciprocal Public License ("RPL")
!* Version 1.5, https://opensource.org/licenses/RPL-1.5 or subsequent versions as
!* allowed by the RPL, and You may not copy or use this file in either source code
!* or executable form, except in compliance with the terms and conditions of the RPL.
!*
!* All software distributed under the RPL is provided strictly on an "AS IS" basis,
!* WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, AND LICENSOR HEREBY
!* DISCLAIMS ALL SUCH WARRANTIES, INCLUDING WITHOUT LIMITATION, ANY WARRANTIES OF
!* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, QUIET ENJOYMENT, OR NON-INFRINGEMENT.
!* See the RPL for specific language governing rights and limitations under the RPL.
!*
!* ==========================================
!* The dispersion model EPISODE (Grønskei et. al., 1993; Larssen et al., 1994;
!* Walker et al., 1992, 1999; Slørdal et al., 2003, 2008) is an Eulerian grid model
!* with embedded subgrid models for calculations of pollutant concentrations resulting
!* from different types of sources (area-, line- and point sources). EPISODE solves the
!* time dependent advection/-diffusion equation on a 3 dimensional grid.
!* Finite difference numerical methods are applied to integrate the solution forward in time.
!* It also includes extensions as the implementation of a simplified EMEP photochemistry
!* scheme for urban areas (Walker et al. 2004) and a scheme for Secondary Organic Aerosol
!* implemented by Håvard Slørdal
!*
!* Grønskei, K.E., Walker, S.E., Gram, F. (1993) Evaluation of a model for hourly spatial
!*    concentrations distributions. Atmos. Environ., 27B, 105-120.
!* Larssen, S., Grønskei, K.E., Gram, F., Hagen, L.O., Walker, S.E. (1994) Verification of
!*    urban scale time-dependent dispersion model with sub-grid elements in Oslo, Norway.
!*    In: Air poll. modelling and its appl. X. New York, Plenum Press.
!* Slørdal, L.H., McInnes, H., Krognes, T. (2008): The Air Quality Information System AirQUIS.
!*    Info. Techn. Environ. Eng., 1, 40-47, 2008.
!* Slørdal, L.H., Walker, S.-E., Solberg, S. (2003) The Urban Air Dispersion Model EPISODE
!*    applied in AirQUIS. Technical Description. NILU TR 12/2003. ISBN 82-425-1522-0.
!* Walker, S.E., Grønskei, K.E. (1992) Spredningsberegninger for on-line overvåking i Grenland.
!*    Programbeskrivelse og brukerveiledning. Lillestrøm,
!*    Norwegian Institute for Air Research (NILU OR 55/92).
!* Walker, S.E., Slørdal, L.H., Guerreiro, C., Gram, F., Grønskei, K.E. (1999) Air pollution
!*    exposure monitoring and estimation. Part II. Model evaluation and population exposure.
!*    J. Environ. Monit, 1, 321-326.
!* Walker, S.-E., Solberg, S., Denby, B. (2003) Development and implementation of a
!*    simplified EMEP photochemistry scheme for urban areas in EPISODE. NILU TR 13/2013.
!*    ISBN 82-425-1524-7
!*****************************************************************************!

      subroutine CSTATM

! The subroutine updates main grid concentration statistics.
! Changed this routine so that averages (only) are calculated for all compounds 1:NC
! Should be further updated for the other statistics
! ----------------------------------------------------------------------------------
! Based on:
! Version Episode 5.5 (May29, 2012) prepared for BB-Stand-Alone
! Original source code of EPISODE by Sam-Erik Walker (NILU)
!
! Sam-Erik Walker
! Norwegian Institute for Air Research (NILU)
! Instituttveien 18 P.O. Box 100
! N-2027 Kjeller, NORWAY
! Tel: +47 63898000 Fax: +47 63898050
! E-mail: sam-erik.walker@nilu.no
!
! ----------------------------------------------------------------------------------
! ----------------------------------------------------------------------------------
! REVISION HISTORY
!
!           2017  M. Karl: Calculation of CMAVED is now inside tsstat.for
!
! ----------------------------------------------------------------------------------

      use mod_util
      use mod_main
      use mod_site
      use mod_time
      use mod_mete
      use mod_conc
      use mod_depo
      use mod_stat

      implicit none

! *** Local variables

      real    :: CMHIGHDMAX
      real    :: CMHIGHHMAX
      real    :: CMHIGHDMIN
      real    :: CMHIGHHMIN
      real    :: TMPV

      integer :: IC
      integer :: IHIGHH
      integer :: IHIGHD
      integer :: IV
      integer :: IVMAX
      integer :: IX
      integer :: IY

! CMHIGHDMAX - Maximum of highest daily  concentration values
! CMHIGHDMIN - Minimum of highest daily  concentration values
! CMHIGHHMAX - Maximum of highest daily  concentration values
! CMHIGHHMIN - Minimum of highest hourly concentration values
! TMPV       - Temporary swap value
! IC         - Compound index
! IHIGHH     - Highest hourly concentrations index
! IHIGHD     - Highest daily  concentrations index
! IV         - Index value
! IVMAX      - Index value
! IX         - Main grid index in x-direction
! IY         - Main grid index in y-direction

! *** External functions:

!MSK      LOGICAL ATDATE

! *** If no grid cells then return

      IF (NX .EQ. 0 .OR. NY .EQ. 0) RETURN

! *** UPDATE HIGHEST HOURLY CONCENTRATIONS:

! *** Number of highest hourly values set to zero or missing?
! *** Then skip the treatment of the NHIGHH highest conc.

      IF (NHIGHH .LE. 0) GOTO 199

! *** Go through all compounds

      DO 100 IC = 1,NC

! ***   Only calculate statistics for compound nr. 1:
!        IF (IC .GT. 1) GOTO 100
!MSK        IF (IC /= ICSTAT) GOTO 100
!MSK start
!           if ( cmpnd(ic) .ne. cpnstat(1) )  goto 100
!MSK end

! ***   Check if missing data for current compound, then go to next compund.
        IF (CM(1,1,IC) .EQ. MISS) GOTO 100

! ***   Go through all main grid cells:
        DO 110 IY = 1,NY
          DO 120 IX = 1,NX

! ***       Check if current main grid value is .LE. than the smallest of
! ***       the NHIGHH values collected so far, if so go to next grid cell:

            IV = IMHIGHHMIN(IX,IY)
            IF (CM(IX,IY,IC) .LE. CMHIGHH(IV,IX,IY)) GOTO 120

! ***       No!

! ***       Collect the current main grid value

            CMHIGHH(IV,IX,IY) = CM(IX,IY,IC)

! ***       Find lowest concentration value collected so far

            CMHIGHHMIN = 1.E+30
            DO 130 IHIGHH = 1,NHIGHH
              IF (CMHIGHH(IHIGHH,IX,IY) .LT. CMHIGHHMIN) THEN
                CMHIGHHMIN = CMHIGHH(IHIGHH,IX,IY)
                IV = IHIGHH
              ENDIF
  130       CONTINUE

! ***       Update the minimum value index

            IMHIGHHMIN(IX,IY) = IV

! ***       Next main grid cell

  120     CONTINUE
  110   CONTINUE

! ***   Next compound

  100 CONTINUE

  199 CONTINUE

! *** UPDATE DAILY MEAN CONCENTRATIONS

! *** Calculate daily mean indicator set to zero or missing?

      IF (IAVED .LE. 0) GOTO 299

      DO 200 IC = 1,NC

!MSK start
!MSK For all compounds
!MSK Receptor concentration CMAVED is hourly mean
!MSK Therefore calculation of CMAVED is now inside tsstat.for
!MSK Below is commented
!MSK
!MSK          DO IY = 1,NY
!MSK            DO IX = 1,NX
!MSK             IF (CM(IX,IY,IC) .lt. 0.0) THEN
!MSK               print *,'cstatm: CM(IX,IY,IC)', CM(IX,IY,IC)
!MSK               print *,'cstatm: STOPPED'
!MSK               STOP
!MSK             ENDIF
!MSK            ENDDO
!MSK          ENDDO
!MSK
!MSK ! Add to daily mean arrays
!MSK
!MSK          DO 210 IY = 1,NY
!MSK            DO 220 IX = 1,NX
!MSK              CMAVED(IX,IY,IC) = CMAVED(IX,IY,IC) + CM(IX,IY,IC)
!MSK  220       CONTINUE
!MSK  210     CONTINUE
!MSK end

!MSK start
! *** Set the NAVED counter for the daily mean here
          IF (IC .eq. 1)  NAVED = NAVED + 1
!MSK end

! Next compound

  200 CONTINUE

      IF (HOUR .NE. 23) GOTO 299

!MSK Below is commented
!MSK ! Calculate daily mean value?
!MSK  ! Yes!
!MSK  ! Calculate daily mean
!MSK
!MSK      IF (NAVED .GE. 20) THEN
!MSK
!MSK          DO IC = 1,NC
!MSK          DO 230 IY = 1,NY
!MSK          DO 240 IX = 1,NX
!MSK              CMAVED(IX,IY,IC) = CMAVED(IX,IY,IC)/NAVED
!MSK                IF ( CMAVED(IX,IY,IC) .lt. 0.0 ) THEN
!MSK                  print *,'CSTATM: CMAVED < 0', IC,IX,IY,CMAVED(IX,IY,IC)
!MSK                  print *,'CSTATM: stopped'
!MSK                  STOP
!MSK                ENDIF
!MSK  240     CONTINUE
!MSK  230     CONTINUE
!MSK
!MSK          ENDDO
!MSK
!MSK
!MSK      ELSE
!MSK               print *,'cstatm: NAVED .lt. 20', NAVED
!MSK               print *,'cstatm: STOPPED'
!MSK               STOP
!MSK
!MSK      ENDIF

  299 CONTINUE

! UPDATE OVERALL MEAN CONCENTRATIONS

! Calculate overall mean indicator set to zero or missing?

      IF (IAVEA .LE. 0) GOTO 399

! Add to overall mean value

      DO 300 IC = 1,NC

! Only add for compound nr. 1

!          IF (IC .GT. 1) GOTO 300
!          IF (IC /= ICSTAT) GOTO 300

! Check if missing data for current compound

!MSK start
!MSK          IF (CM(1,1,IC) .EQ. MISS) GOTO 300
          DO IY = 1,NY
            DO IX = 1,NX
             IF (CM(IX,IY,IC) .lt. 0.0) THEN
               print *,'cstatm: overall mean CM(IX,IY,IC)', CM(IX,IY,IC)
               print *,'cstatm: STOPPED'
               STOP
             ENDIF
            ENDDO
          ENDDO
!MSK end

! Add to overall mean arrays

          DO 310 IY = 1,NY
          DO 320 IX = 1,NX
              CMAVEA(IX,IY,IC) = CMAVEA(IX,IY,IC) + CM(IX,IY,IC)
  320     CONTINUE
  310     CONTINUE

!MSK start
!      NAVEA = NAVEA + 1
          IF (IC .eq. 1)  NAVEA = NAVEA + 1
!MSK end

! Next compound

  300 CONTINUE

! Calculate overall mean value?

      IF (.NOT. (ATDATE(EDAT) .AND.     &
       ISH .EQ. NSH .AND. ITS .EQ. NTS)) GOTO 399

! Yes!

! Calculate overall mean

      IF (NAVEA .GT. 0) THEN

          DO IC = 1,NC
          DO 350 IY = 1,NY
          DO 360 IX = 1,NX
              CMAVEA(IX,IY,IC) = CMAVEA(IX,IY,IC)/NAVEA
  360     CONTINUE
  350     CONTINUE
          ENDDO

      ELSE

          DO IC = 1,NC
           DO 355 IY = 1,NY
            DO 365 IX = 1,NX
              CMAVEA(IX,IY,IC) = MISS
  365     CONTINUE
  355     CONTINUE
          ENDDO

      ENDIF

  399 CONTINUE

! UPDATE HIGHEST DAILY CONCENTRATIONS

! Number of highest daily values set to zero or missing?

      IF (NHIGHD .LE. 0) GOTO 499

! Go through all compounds

      DO 400 IC = 1,NC

! Only calculate statistics for compound nr. 1

!          IF (IC .GT. 1) GOTO 400
!MSK          IF (IC /= ICSTAT) GOTO 400
!MSK start
!           if ( cmpnd(ic) .ne. cpnstat(1) )  goto 400
!MSK end

! Calculate statistics?

          IF (HOUR .NE. 23) GOTO 400

! Yes!

! Check if missing data

          IF (CMAVED(1,1,IC) .EQ. MISS) GOTO 400

! No!

! Go through all main grid cells

          DO 410 IY = 1,NY
          DO 420 IX = 1,NX

! Check if current main grid value is smaller than the smallest
! of the NHIGHD values collected so far

!MSK: ATTENTION CMHIGHD has to be changed to index IX,IY,IC

              IV = IMHIGHDMIN(IX,IY)
              IF (CMAVED(IX,IY,IC) .LE. CMHIGHD(IV,IX,IY)) GOTO 420

! No!

! Collect the current main grid value and update the minimum
! value index

              CMHIGHD(IV,IX,IY) = CMAVED(IX,IY,IC)

! Find lowest concentration value collected so far

              CMHIGHDMIN = 1.E+30
              DO 430 IHIGHD = 1,NHIGHD
                  IF (CMHIGHD(IHIGHD,IX,IY) .LT. CMHIGHDMIN) THEN
                      CMHIGHDMIN = CMHIGHD(IHIGHD,IX,IY)
                      IV = IHIGHD
                  ENDIF
  430         CONTINUE

! Update lowest value index

              IMHIGHDMIN(IX,IY) = IV

! Next main grid cell

  420     CONTINUE
  410     CONTINUE

! Next compound

  400 CONTINUE

  499 CONTINUE

! SORT HIGHEST HOURLY AND DAILY CONCENTRATIONS

! Check if at end of simulations or daily statistics of highest
! hourly concentrations wanted

         IF (.NOT. ((ATDATE(EDAT) .AND.     &
             ISH .EQ. NSH .AND. ITS .EQ. NTS) .OR.     &
            (HOUR .EQ. 23 .AND. IDSTA .EQ. 1))) RETURN

! Yes!

! Number of highest hourly values set to zero or missing?

      IF (NHIGHH .LE. 0) GOTO 599

! Sort the main grid highest hourly concentration values

      DO 500 IY = 1,NY
        DO 510 IX = 1,NX

! Sort the values in descending order

          IHIGHH = 0
  520     CONTINUE

! Initialize current value

          IHIGHH = IHIGHH + 1
          CMHIGHHMAX = CMHIGHH(IHIGHH,IX,IY)
          IVMAX = IHIGHH

! Find highest value in the rest of the array

          DO 530 IV = IHIGHH+1,NHIGHH
              IF (CMHIGHH(IV,IX,IY) .GT. CMHIGHHMAX) THEN
                  CMHIGHHMAX = CMHIGHH(IV,IX,IY)
                  IVMAX = IV
              ENDIF
  530     CONTINUE

! Swap current value with highest value

          IF (CMHIGHHMAX .GT. CMHIGHH(IHIGHH,IX,IY)) THEN
              TMPV = CMHIGHH(IHIGHH,IX,IY)
              CMHIGHH(IHIGHH,IX,IY) = CMHIGHHMAX
              CMHIGHH(IVMAX,IX,IY) = TMPV
          ENDIF

! Finished with array?

          IF (IHIGHH .LT. NHIGHH) GOTO 520

! Yes! Array sorted in descending order

           IMHIGHHMIN(IX,IY) = NHIGHH

  510 CONTINUE
  500 CONTINUE

  599 CONTINUE

! Number of highest daily values set to zero or missing?

      IF (NHIGHD .LE. 0) GOTO 699

! Sort the main grid highest daily concentration values

      DO 600 IY = 1,NY
        DO 610 IX = 1,NX

! Sort the values in descending order

          IHIGHD = 0
  620     CONTINUE

! Initialize current value

          IHIGHD = IHIGHD + 1
          CMHIGHDMAX = CMHIGHD(IHIGHD,IX,IY)
          IVMAX = IHIGHD

! Find highest value in the rest of the array

          DO 630 IV = IHIGHD+1,NHIGHD
              IF (CMHIGHD(IV,IX,IY) .GT. CMHIGHDMAX) THEN
                  CMHIGHDMAX = CMHIGHD(IV,IX,IY)
                  IVMAX = IV
              ENDIF
  630     CONTINUE

! Swap current value with highest value

          IF (CMHIGHDMAX .GT. CMHIGHD(IHIGHD,IX,IY)) THEN
              TMPV = CMHIGHD(IHIGHD,IX,IY)
              CMHIGHD(IHIGHD,IX,IY) = CMHIGHDMAX
              CMHIGHD(IVMAX,IX,IY) = TMPV
          ENDIF

! Finished with array?

          IF (IHIGHD .LT. NHIGHD) GOTO 620

! Yes! Array sorted in descending order

           IMHIGHDMIN(IX,IY) = NHIGHD

  610 CONTINUE
  600 CONTINUE

  699 CONTINUE

! UPDATE TOTAL WET DEPOSITIONS

! Add to overall total value

      DO 700 IC = 1,NC

! Check if missing data for current compound

          IF (WDEPM(1,1,IC) .EQ. MISS) GOTO 700

! Add to total overall arrays

          DO 710 IY = 1,NY
          DO 720 IX = 1,NX
              WMTOTA(IX,IY,IC) = WMTOTA(IX,IY,IC) + WDEPM(IX,IY,IC)
  720     CONTINUE
  710     CONTINUE

! Next compound

  700 CONTINUE

      RETURN

! End of subroutine CSTATM

      end subroutine cstatm

max_stars_repo_name: mdhillmancmcl/TheWorldAvatar-CMCL-Fork

max_issues_repo_name: mdhillmancmcl/TheWorldAvatar-CMCL-Fork

max_forks_repo_name: mdhillmancmcl/TheWorldAvatar-CMCL-Fork


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

C=======================================================================
      SUBROUTINE DBIQA (NDB, OPTION,
     &   MAXQA, MAXINF, NQAREC, QAREC, NINFO, INFO,
     &   EXODUS, *)
C=======================================================================

C   --*** DBIQA *** (EXOLIB) Read QA and information records
C   --   Written by Amy Gilkey - revised 02/08/88
C   --
C   --DBIQA reads the QA records and the information records.
C   --
C   --Note that the number of QA records and information records to be read
C   --are read in this routine.
C   --
C   --This routine calls DBIV0.
C   --
C   --Parameters:
C   --   NDB - IN - the database number
C   --   OPTION - IN - ' ' to not store, '*' to store all, else store options:
C   --      'Q' to store QA records
C   --      'I' to store information records
C   --   MAXQA - IN - the maximum number of QA records to store
C   --   MAXINF - IN - the number of information records to store
C   --   NQAREC - OUT - the number of QA records; <0 if end-of-file
C   --   QAREC - OUT - the QA records containing: (if OPTION)
C   --      (1) - the analysis code name
C   --      (2) - the analysis code QA descriptor
C   --      (3) - the analysis date
C   --      (4) - the analysis time
C   --   NINFO - OUT - the number of information records; <0 if end-of-file
C   --   INFO - OUT - the information records (if OPTION)
C   --   EXODUS - OUT - false if GENESIS file, true if EXODUS file so far
C   --   * - return statement if error encountered, including end-of-file;
C   --      NOT used if valid GENESIS file; message is printed
C   --
C   --Database must be positioned at start of QA records upon entry;
C   --upon exit positioned at end of information records.

      INTEGER NDB
      CHARACTER*(*) OPTION
      INTEGER MAXQA, MAXINF
      INTEGER NQAREC
      CHARACTER*8 QAREC(4,*)
      INTEGER NINFO
      CHARACTER*80 INFO(*)
      LOGICAL EXODUS

      CHARACTER*80 ERRMSG

      EXODUS = .FALSE.
      NQAREC = -999
      NINFO = -999

      READ (NDB, END=160, ERR=170, IOSTAT=IERR) NQAREC

C ... If too many records, skip early records and store last written ones.
      IF ((OPTION .EQ. '*') .OR. (INDEX (OPTION, 'Q') .GT. 0)) THEN
         iskp = max(0, nqarec - maxqa)
         DO 110 IQA = 1, iskp
            READ (NDB, END=180, ERR=180, IOSTAT=IERR)
  110    CONTINUE
         DO 100 IQA = 1, MIN (MAXQA, NQAREC)
            READ (NDB, END=180, ERR=180, IOSTAT=IERR)
     &         (QAREC(I,IQA), I=1,4)
  100    CONTINUE
      ELSE
         DO 120 IQA = 1, NQAREC
            READ (NDB, END=180, ERR=180, IOSTAT=IERR)
  120    CONTINUE
      END IF

      READ (NDB, END=160, ERR=190, IOSTAT=IERR) NINFO

C ... If too many records, skip early records and store last written ones.
      IF ((OPTION .EQ. '*') .OR. (INDEX (OPTION, 'I') .GT. 0)) THEN
         iskp = max(0, ninfo - maxinf)
         DO 140 I = 1, iskp
            READ (NDB, END=200, ERR=200, IOSTAT=IERR)
  140    CONTINUE
         DO 130 I = 1, MIN (MAXINF, NINFO)
            READ (NDB, END=200, ERR=200, IOSTAT=IERR) INFO(I)
  130    CONTINUE
      ELSE
         DO 150 I = 1, NINFO
            READ (NDB, END=200, ERR=200, IOSTAT=IERR)
  150    CONTINUE
      END IF

      EXODUS = .TRUE.

      CALL DBIV0 (NQAREC, NINFO)

  160 CONTINUE
      RETURN

  170 CONTINUE
      ERRMSG = 'NUMBER OF QA RECORDS'
      GOTO 210
  180 CONTINUE
      ERRMSG = 'QA RECORDS'
      GOTO 210
  190 CONTINUE
      ERRMSG = 'NUMBER OF INFORMATION RECORDS'
      GOTO 210
  200 CONTINUE
      ERRMSG = 'INFORMATION RECORDS'
      GOTO 210
  210 CONTINUE
      CALL DBERR (IERR, ERRMSG)
      RETURN 1
      END

ext: f

max_stars_repo_name: jschueller/seacas

max_issues_repo_name: jschueller/seacas

max_forks_repo_name: jschueller/seacas


text:
      subroutine clawpack46_set_capacity(mx,my,mbc,dx,dy,
     &      area,mcapa,maux,aux)
      implicit none

      integer mbc, mx, my, maux, mcapa
      double precision dx, dy
      double precision  aux(1-mbc:mx+mbc,1-mbc:my+mbc, maux)
      double precision area(-mbc:mx+mbc+1,-mbc:my+mbc+1)

      integer i,j
      double precision dxdy

      dxdy = dx*dy

      do j = 1-mbc,my+mbc
         do i = 1-mbc,mx+mbc
            aux(i,j,mcapa) = area(i,j)/dxdy
         enddo
      enddo

      end

max_stars_repo_name: ECLAIRWaveS/ForestClaw

max_issues_repo_name: ECLAIRWaveS/ForestClaw

max_forks_repo_name: ECLAIRWaveS/ForestClaw


text:
Kims Mart is Davis primary Asian market, and includes Korean, Chinese, Japanese, and Thai food items. Prices at Kims are pretty much in line with those offered by most Asian grocery stores, and wiki users seems to be in agreement that the owner is a wonderful person and prices are fair. We love Kims!! There is a $10 Credit Card Minimum Purchase minimum for ATM and credit card purchases.

The selection is pretty broad considering the stores size  aside from the usual packed goods such as rice, ramen, rice crackers, spices and sauces, Kims offers both frozen and fresh refrigerated foods including vegetables and side dishes (called banchan in Korean). Tapioca drinks Tapioca drink lovers can get their tapioca balls (aka boba or bubble or pearl) here in a variety of sizes for much less than the cost of ready made drinks!  They also have a variety of Asian teas such as barley and oolong tea.

Customers can also pick up some basic household items such as high quality rice cookers, very economical mandolines, decent toothpicks versus poorly milled American toothpicks, chopsticks, soy sauce containers, international calling cards, etc. Near the front counter are okashi, some fun candy candies, Pocky, fresh mochi, mochi ice cream, origami materials, and just a great mix of items. Try the red bean or melon popsicle for a cheap and tasty treat.  They may be the only place in Davis to get miso paste.

Kimbap

The wiki:WikiPedia:kimbap (or Kimbap, similar to sushi, and sometimes called Korean sushi) is excellent and well priced.  At the register, you can purchase two decentsized rolls of kimbap fresh made for the lunch hours for about 3 dollars.  Different versions are available if you get there early enough. Jap Chae (Korean glass noodles) can also be a tasty ready to eat lunch or snack for $2.99.

  Original (18 pieces)  $2.99   imitation crab, tofu, pickled daikon, carrot, egg
  California roll (21 pieces)  $3.99  avocado, minced imitation crab, cucumber
  Tuna salad roll (21 pieces)  $3.99  Tuna salad, pickled daikon, lettuce, carrot
  Korean BBQ beef roll (21 pieces)  $3.99  bbq beef, pickled daikon, lettuce, carrot
  Vegetarian roll (21 pieces)  $3.99  avocado, pickled daikon, carrot

See also: Ethnic Markets.

Although the prices might seem high, relative to asian products you find at grocery stores such as Safeway, the prices are GREAT.  Ive purchased sushi supplies several times from Kims mart such as nori and rice vinegar, and everything cost about half as much.  Users/NatalieKitchiner

20050201 16:44:41 nbsp Considering that Kims is the only Asian market in Davis, I think its really important to support the place. Besides, the woman who owns the place is very friendly! Having grown up in Sac and shopped its Asian stores for years, I dont think Kims prices are out of line. Users/AlphaDog

20050311 15:58:24 nbsp this place is the best kept secret for a cheap lunch in Davis.  i get some Korean sushi for only 2.99, and thats 18 pieces.  i leave bloated its so much food, and its cheeper than fast food and so much better. you really have to try the sushi, its made by the owner and is sold at the register.  like i say its the best deal in davis Users/MattHh

20050510 nbsp Friendly owner and a great resource for Davis. The prices are the best around. I enjoy the little extra, nonfood items available origami kits, dishes.  Users/DavidPonce

20050517 20:42:12 nbsp Kims is such a gem.  Thank god Davis has it.  This is pretty much the only place youll find spring roll wrappers, cans of lychees, Pocky, and curry paste all in one place.  Its fun just to wander around it there and look at all the cool stuff.  Users/SamanthaGrant

20050706 18:45:30 nbsp I was sort of dissapointed with this place, to be honest. there is a place in Santa Rosa called the ThaiLao and it sold better Asian products (plus, oh boy oh boy, THE DELICIOUS DURIAN) and i am pretty sure that there are less people buying asian products in Santa Rosa. the prices are pretty expensive, though i got to admit, the Sushi is pretty good for a bargain. (P.S can anyone tell me if i can get his store to order Durian Fruit? i love it, albeit not really anyone else does...:) Users/StevoDragun

20050706 18:46:55 nbsp is there anyplace that sells Durian products in Davis BESIDES the Sunrise Restaurant? please Help! Users/StevoDragun

Tons of unique asian products, including candy and dried food. However, I would advise against eating the chile flavored mango. Users/SiennaGrass

20050731 22:22:06 nbsp Cold soba noodles are an absolute must for the hot summer months. You can find them at Kims along with the noodle base. Aside from having to boil the noodles on a hot stove, they yield a refreshing meal for the summer. Users/DannieHolden

20050801 12:49:18 nbsp I like the store.  Prices arent bad, especially for a small shop.  As for the comparison with stores in Santa Rosa selling durian, its probably a matter of which asian foods the stores specialize in.  Seeing the Korean language on the sign outside, I knew going in there would be more of that represented and then Japanese and Chinese stuffs, etc.  The lady there was very helpful when I expressed doubt about which items to get for a certain recipe, even though I dont speak Korean.  Also, Korean ramen is way better than the ramen you get at the supermarket, so make the switch!  If you find neungmyun, go for it. Users/IrenePark

20050802 18:51:08 nbsp The prices are quite high, especially compared to places like Nijiya Market in San Franciscos Japantown. The curry croquettes cost significantly more. Also, they recently removed the taiyaki, which sort of upset me. However as a balance, the Korean sushi is definitely one of the best quick meal options around, cheap, filling and tasty and the lady that runs the store is a really nice person. Overall, expensive, but worth it, if you cant find the time to drive all the way back to SF, fairly good selection of snack food, moderate selection of mealstuffs (mostly instant stuff).  Users/MatthewTom

20050831 12:54:10 nbsp They sell peeled garlic here by the baggies, which is nice if you cook with it a lot and dont want to bother peeling it all the time.  The lady was nice enough to find me a fresh bag and helped me find proper ingredients for a dish I was making for the first time.  They have some vegetables and such in the refrigerators, like green onion and the smaller cucumbers that are different from the American versions found at the supermarkets. Users/IrenePark

20070121 13:52:25 nbsp Dont buy the kimchi here, the quality has hit rock bottom over time, its slimy. Just go to SF Market, they sell Kosmos and King brand kimchi Users/TheStomach

20070121 22:34:42 nbsp The moche is good, but overall I hear talk of overpriced things, but Kims is small on the grand scheme of Asian markets. Users/StevenDaubert

20070427 17:55:43 nbsp I like their sushi plates and side dishes; however, most of their snacks are either w/o exp date or expired when you can find a date. I have been visiting there frequently to buy snacks like rice crackers until I noticed that the foods were dated; I went there several times afterwards only found that they always sell foods w/o exp. date or stale ones. I am not going there anymore, and I feel very unhappy about the fact that I had already eaten large amount of bad foods.  Users/ZoeyJW

20070509 00:43:39 nbsp Their cheap sushi tastes pretty bad but is still worth its price when youre really hungry! Users/MikeHubby

20070517 08:44:41 nbsp The owner is friendly, I can get my bag of Tamakimai Gold there, cases of Shin ramyun, and other miscellaneous items that I would otherwise have to go to Sac for. Prices are marginally higher but you wont be saving yourself any money by driving to Sac and heck, why not support what is obviously a family owned establishment? The sushi isnt spectacular but its solid in terms of quality/quantity for the price. I can see how western folks wouldnt be thrilled by the more traditional (and thus conservative ingredient choices) types of rolls they offer. Users/MasumiWatanabe

20070616 11:01:14 nbsp I just bought some cookies there and the cashier ripped me off.  I gave her my cash and she gave me the wrong change back in her favor.  So if you shop here make sure they charge you right. Users/Animorpha

20070722 18:26:46 nbsp ONLY ASIAN MARKET IN DAVIS! That speaks for itself. They try hard to include Chinese and Japanese items also, not just Korean. Cheap popsicles too. Good selection of snacks. Users/AlexandraDeGrange

20070826 19:19:24 nbsp I would agree the sushi isnt too good, but I buy it every time I go there, just as a snack.  Also, the kim chi is alright, I like it because it reminds me of my grandmas.  I would also like to confess that Kims kim chi is a lot better than massproduced Kings.  I bought Kings once, out of desperation for kim chi, and I vowed never to buy it again.  Ill definitely buy Kims kim chi over Kings.  However, I bought food items there before that were expired but still on the shelf.  I had to throw them out when I got home.  So check the expiration dates! Users/KristinaKarson

20070908 13:49:34 nbsp The lady at the register was very kind and polite. It was a very positive experience. I recommend the dollar pocky boxes for a treat and the frozen steamed buns she keeps in the back. The vegetable ones are simply delicious! The sushi is expensive, and keep in mind that korean style sushi is different than what you would get elsewhere. It seems lovingly handmade however, and she is proud of it. I am looking forward to buying some kimchi and boba there.  Users/AnnaF

20070929 16:22:00 nbsp I heard from my cousin that this place is closed due to an end of their lease. Can anyone confirm that this is indeed a Departed Business? Users/AlexQuan

I confirmed myself that indeed the business is still there, in whole. Thanks to my cousin for CONFUSION. Users/AlexQuan

20071001 09:42:26 nbsp Shes super nice... and has almost everything you need. If she doesnt have it though, shell get it for you. Prices are fair considering its down the street vs. driving to Sacramento for Asian stuff. She even let me come back the next day and pay for snacks I got for my kids as she was locking up.Users/Aaron.Curtin

20071101 19:57:19 nbsp Kims Mart has got to be one of my favorite places in Davis. If you are hungry, you can stuff yourself with their homemade sushi rolls, sweet snacks, candies, etc. The prices may be a little high, but it is better than driving all the way to Sac for some needed asian ingredients. My favorite ready to eat food that Kims Mart offers has got to be the tuna salad roll (spicy/nonspicy)! For just 3.99, you get to stuff yourself with 21 pieces of sushi!!!! Users/BerniceManiago

20071106 14:14:16 nbsp How late is the sushi usually around? Users/BenjaminRosenstein
 20071201 17:06:52 nbsp I went there at around 4:30 PM and there were Tuna Salad rolls left Users/KNT

20080110 18:41:57 nbsp I really like the sushi and I also like the kimchi. No complaints on the selection of stuff either! I dont know I always think that the lady is really nice to me... The first time I went in she immediately and proudly recommended her rolls. I think the prices in general for supplies might be a bit much, but it is the only place that stocks asian products... all in all, Id recommend everyone to take a visit. Users/CalvinCheng

20080122 13:48:53 nbsp Just went there is weekend. The store is really small, but has lots of goodies. I love the sushi rolls and Im really glad she has most of the indgredients that I needed to cook. Although the prices were a bit more than at Sacramento, it is the same as if I went to Sac since the prices makes up the gas driving there. The owner is really friendly and I enjoy this place. I will come by again :D Users/ChiYang

20080223 18:42:27 nbsp love the Kimbap, reasonably priced, tastes great, and filling Users/APT

20080228 16:42:15 nbsp im not a kimchi afficionado by anymeans, but Iilike their kimchi! its a lot better than many store brands ive tried and i especially like how its not overly salty. sushi rolls are decent and the lady is really nice too. Users/AmberHMa

20080302 10:48:05 nbsp Favorite store in Davis! I love the sushi and kimchi here! Users/NicoleBush

20080316 12:43:11 nbsp Great place to buy Asian ingredients and accessories. They make their own kimchi and it tastes great. Their kimbap (korean style sushi) is well priced, tastes home made, and the portions are huge enough for a meal.  Users/justinhu

20080323 01:11:51 nbsp According to the sign in the window of where Pallens Martial Arts used to be (before they moved to the old bike shop next to WaMu), Kims Mart will be moving to that location. If thats true, its going to be humongous! Users/ScarlettYing

  interesting. So those are the people applying for the liquor liscence. I thought it was going to be another restaurant. Good for them, their ilses are really cramped in that tiny store. I love them. But during the move who will suply my kim bap fix :( Users/MattHh

  They are moving?  I thought they were expanding into the place next door. Users/SunjeetBaadkar

  They are moving two stalls over, so instead of being to the left of the hair salon, they will be on the right.Users/ScottWong

20080402 21:09:21 nbsp This place is so overpriced than the regular Korean markets Ive gone to, and I understand this is because its the only Asian store. I would like to consider this place to be the source of my daily needs for food if it didnt rip me off so much. Users/Aarolye

20080408 15:03:41 nbsp The owner is very friendly. Relative to other stores, the prices are decent. I just purchased some frozen korean side dishes and some grape BONBON. Im so excited! Definitely going to be visiting Kims more often! Users/VTang

20080422 23:27:41 nbsp somebody keeps hording all the Mild Seven Lights in one go. : (
but a great place to go when you get nostalgic of korea. frozen dumplings are great. i wish they had the green tea flavored greenheim snacks. hells yeah. oh well, the coffee flavored one is good too. just toss em in the freezer. : )  Users/beekergene

They now sell Japchae (cellophane noodles sauted with vegetables and sesame oil) next to the kimbap (korean sushi).  It is really tasty (even better than the kimbap), but not as filling.  Users/jbh

20080516 15:39:02 nbsp Kims market also has Lotte gum sweetened with xylitol which is good for preventing cavities. Users/DagonJones

20080607 20:44:02 nbsp Kim now seals bibimbap items in a tray for 3.99. Good deal because you can easily cook and fry an egg at home. Users/justinhu

20080609 19:27:24 nbsp The kimbap are great and well worth it. Users/Noobster123

20080613 13:13:06 nbsp I love the sushi and the drinks, and practically everything there.  Its very cheap, delicious, and Kim is very nice.  Has a nice variety too.  Users/jrendler

20080705 14:53:29 nbsp Kims mart is really expensive. I like their kimbap and their togobibimbap (but the bibimbap has too little meat). The place is better now that they expanded but so many items are overpriced and a lot of items are passed their expiration date. If you dont mind the drive I would suggest going to Otos in Sac or some other Asian Market in Sac. Users/islandboy12

20080807 13:59:19 nbsp I dont know why people keep mentioning the price, so one really thinks driving to Sac or even SF is a good idea when all they want is a jar of black bean paste. Heck the prices at this place are pretty much on par with most westernized types of Asian supermarkets in S.F. They have a great selection of pastes, sauces, and even vegetables. They have tamarind paste!!! This place is excellent for someone who wants to make a nice home style (Asiany) meal. I feel terrible that I didnt shop here when getting ingredients. Oh they also have a good selection of snacky foods including baked goods like swiss rolls! Users/csy

20080828 17:35:20 nbsp I love kims. The frozen fish is good quality, and comparitively cheap. Its the only place in town to get good japanese style rice. As mentioned, the prepared foods are goods, especially the seaweed salad. Yes, prices are higher then the asian markets in the middle of little saigon, but then again, davis doesnt have nearly the market of large cities with large asian populations. Compared to other stores in the area, kims is cheap, good quality, and you can find a lot of things here you cant find elsewhere. The people that work there are nice as well, especially if you are a regular. Users/ascapoccia

20080829 10:29:46 nbsp It would be great if this place had a spot in the corner for a microwave and water (or better yet, hot water) dispenser.  Id love to be able to make some of those instant meal things they sell considering Im in the downtown area for over 14 hours of the day and dont get much time to actually take stuff home to prepare.  But otherwise, awesome place considering its Davis. Users/SunjeetBaadkar

20080910 14:32:40 nbsp Love Kims.  I started coming in and ordering vegetarian rolls for my daughter and one day I came in and they had started making them  so now I dont always have to order ahead.  I buy kimchi and garlic and ginger root and their sushi regularly and now they are expanded they seem to have even more good stuff  or maybe I can just see it now.  I like that I can push a little cart around now! BeckeM Users/Becke

20080911 07:50:52 nbsp Kims Mart is the best in town  reasonable prices, quality foods. Their new store layout is way better than the old one. My personal favorite is the Korean BBQ beef roll, yum! I also recommend the California roll, the original Kimbap. If you prefer something new, try their all new Korean noodles ticks ($2.99) ) Users/T.CHOW
   You mean the only Asian market in town?

20080927 17:23:18 nbsp I thought that yes, indeed, the lady is very nice. The kimpap is really good also. But I thought that certain items (only certain) are way too high. Its better to just buy it when you visit home and then just bring it. Ex: I really wanted to buy those Korean SHIN bowl noodles, it cost around $8.99 at Ranch 99 at SJ, but in Kims, its $21. So...if its not something that you REALLY want and can wait till home, I suggest wait till home. :) The snacks are decent priced there, its not cheap, but doesnt cost much more than probably your hometown supermarkets. Its definitely worth going. The kimbap and other of those little Korean dishes are yummy. The lady was also nice enough to give us wooden chopsticks and packages of soy sauce. Users/PKYCHEUNG

20081015 23:54:35 nbsp Kims is awesome.
The lady there is so nice. One day she said I looked really nice and kind that she gave me a free plate of chapchae!
It made my day! : )
Cup ramens/udons seem pretty expensive though. Other things seem reasonably priced. Users/alexlee333

20081119 18:22:09 nbsp As I am writing this, I am currently eating 4 different rolls. (hey Im hungry!) Anyways, gotta say, the spicy tuna salad roll is the best. I didnt even know they had it until I went to the store. Good stuff. DEFINITELY, coming back for more.  Users/KimN.

  Arent there like 16 pieces in each serving?  Are you seriously eating 64 pieces in one sitting?! Users/SunjeetBaadkar
  Good god no! Although i did try, i ended up eating about half, but that was a damn sure good meal. I have already been back plenty of times. They even have their own cuttlefish. SOOO good!! Users/KimN.

20081202 11:53:19 nbsp mmmmm mochi Users/StevenDaubert

20081203 20:56:34 nbsp She now has a delicious seafood vegetable snack that is over in the same cold case as the Kimbap.  It is delicious.  There was also a new noodle dish of some kind, that looked like it had rice noodles, egg, and vegetables. Does anyone know what that is?   Users/KendraSmith

20081206 12:57:03 nbsp do they sell star anises (bajiao)? Users/WeiChun

20081209 11:00:29 nbsp Im from San Francisco, so this pleace is totally overpriced to me. However, I do enjoy buying their rolls. makes for a quick and cheap meal. Users/renee415

20090209 17:09:27 nbsp The $3.99 rolls are yummy!  The lady behind the counter was very nice.  Would come again. Users/strawberry

20090222 13:18:02 nbsp LOVE this place! Some things are a little expensive, but the kimbap & jap chae are totally worth it! Users/Doro

20090318 21:31:03 nbsp I went to try these famous kimbap rolls, but was a little bit dissapointed. They are not bad, but they werent super great. I think it is a deal with the quantity though, that is for sure. But I think next time I will go to the safeway sushi they make at their deli, it has more fish ( not mixed) in it and its only a dollar more! I think that stuff tastes more like the sushi at a sushi restaurant. But then again, it has less pieces than the kimbap. Users/sgent

20090424 16:23:22 nbsp I love the kimchi. Best one around Davis. Users/precious

20090504 16:32:10 nbsp Most of the stuffs at this place are overpriced. Even though theyre the only Asian market around, they should really think about the student budget. Users/thtly

20090624 17:01:42 nbsp Melon popsicles are so good ) Users/jaredfromsubway

20090804 20:35:51 nbsp Correct me if Im wrong but this seems to be the only place in Davis to get the Japanese style rice?
I always get mochi and kimbap when I come here, very delicious. Users/KristenM

20090911 17:11:10 nbsp This place does seem to have a good mix of items for people who want to cook their own asiany meals, and foods that are ready to eat. One can procure tamarind paste, bean noodles, duck eggs, dried shiitake mushrooms, and yes they have star anise in powdered and whole form in one place. I would think the time one saves with this nifty shop is worthy of your lucre. Users/csy

20091022 01:17:52 nbsp Funky smelling even for an asian store....However, it being the only one in davis, you cant really help the high prices....but if youre looking for korean stuff youre in luck. This store caters to korean cuisine.....yes, there are some other asian foods, but not really...I think I only came here to buy the melon pops (love those things!) If you want asian foods, go to Sacramento; Otos Market on freeport is amazing. Oh, fyi, kimbap and sushi are completely different, so dont come here looking for some Japanese sushi.  Users/allwalksoflife87

20091120 14:56:59 nbsp Kimbap there are heavenly, fresh and such good prices. I brought those to our bookclub couple weeks ago and it was a hit. Theyre always freshly made by the ladies there, and you could even call ahead to request they make x number of packages for you (in case of disappointment).  Users/val

20100525 18:36:36 nbsp To confirm and add onto previous comments, in addition to the kimbap, available side dishes include jap chae, seafood/veggie pancake, and seasoned tofu.  All of these things were still available when I went after 5:30PM... safe to say a selection is probably available until closing. Id recommend trying the jap chae but I havent had the seafood pancake or seasoned tofu yet.
On a different note, Im not sure how people are able to compare Kims kimbap to Safeway sushi... and Ill leave the thought at that. Users/SRB

20100525 19:46:50 nbsp I like Kims Market a lot.  Ive been to many Asian markets and this one scores really high on the helpfulnesstoawhiteguy scale.  I always feel welcome and they always had good answers to my questions.  As to the high prices, blame Davis and blame the landlord, not Kim.  Its flat expensive to be a downtown retailer in Davis.   Users/JimStewart

20100602 13:37:11 nbsp Im glad there is at least one Asian market in Davis. There is a nice selection, but its just more expensive than the items youd get from the Bay or Sac.  Users/PaulV

20100602 16:47:41 nbsp best best best.
everyone is always so nice and cordial.
i can get my favorite apple juices and milk and coffee drinks as well as the candies and foods id either have to go to sac for or order online.
i love them for sure. Users/Mogitha

20100604 14:53:39 nbsp The only place in town that sells the bottled Jasmine Green Tea that I love. Throw in a plate of kimbap and yum. Users/SunjeetBaadkar

20100714 14:45:42 nbsp Saves me a drive out to Sacramento for a pretty good assortment of Japanese ingredients and vegetables. Its no supermarket but Id much rather pick up my groceries here than try to beat the rush hour traffic to get to SF or 99 Ranch. Too pricey? Try buying anything asian foods related at the other stores in Davis, ie. Safeway or Nugget. Seriously, try. Now, I love those stores for what they are, but a kidney is not considered legal tender at those establishments, so give up that idea. Plus, at Kims, you can pick up a giant jar of kimchee or some fresh kimbap. OMG, YUM!   Users/Osenbe

20100716 17:21:31 nbsp This is a great Asian store. The ready made Jap Chae and kimbap are aweseome!! Users/JasperD

20100812 15:58:11 nbsp I bought a bag of wet seedless tamarind from this store. I came home and opened it up. There were tons of seeds in it. I called up the store. A lady answered the phone. I told her that the label of the tamarind did not reflect what was inside it. She said she did not make the label and she could not do anything about it. She told me to bring it back if I did not like it. She even did not say sorry. I guess theyd rather let customers feel cheated than improving their business.  Users/thantrinh90
 Whats wrong with bringing it back if you dont like it? I dont really see the problem with her response.
 Indeed, Im sure Target would just issue a credit card refund if you called and were unhappy with a product.  Bring it back is sort of the standard response if something doesnt work or isnt as expected.

20100903 13:09:17 nbsp As it is the only Asian market in Davis, the steep prices are to be expected. Its a tossup between driving to Sac or not when considering a trip to Kims. Anyways, their selection is pretty decent for what it is and despite the obvious markup, the time saved not having to drive to Sac makes the prices a bit easier to swallow. Users/blastoff

20101102 17:28:44 nbsp i come here for the kimbap. theyre all pretty good. plus, the cashiers are always nice ). Users/SallyVo

20101205 15:31:55 nbsp While I do not have experience with Asian food stores, I went by here today to get a few ingredients for chicken curry.  I got curry paste, water chesnuts, bamboo shoots, and coconut milk for $4.50. Not a bad price.. And for those of you curious, the sushi shelf was about 60% gone, so either the owner doesnt make it on Sundays (or as much) or it is incredibly popular. Users/redbike

20110117 21:08:30 nbsp I really like this place. They have a bunch of stuff you cant find anywhere else in town, and their prices are very good. Also one of the cheapest places to grab a quick premade lunch. Users/twblalock

20110122 17:31:59 nbsp The people who work here are really unfriendly, especially to korean who newly arrived in Davis. I really didnt like the way they treat me when I went here.
Especially, the female owner is really rude. Users/JennyCS

20110131 18:44:30 nbsp Let me start with this, Ive been a regular customer of Kims Mart for the last 2 years. I love the food (even though its slightly over priced) and the male owner, hes really nice aswel. I cant say the same for his wife, the little lady with the curly grey hair. She never really says anything to me when she rings me up, but I just usually smile and get on my way. Except today, I got my usual tofu, noodles, etc and I picked up a package of california rolls. While she was ringing me up (not saying anything as usual) I noticed that the avocado in the sushi was brown, and I asked if I could trade it in for another package. She rudely started poking at the sushi and saying YOU SQUOOSHED IT I think she thought I wanted to trade it in because I squished the saran wrap? I dont know. Anyway, I told her that wasnt the problem and pointed out the discolored avocado. I tried to put the sushi back in the fridge area, and she snatched it away from me and mumbled something Korean. I still ended up getting another package, and paid for my groceries. I was quite frankly a bit disappointed, and dont really want to go back there while shes working. I really think she needs an atitude change, but I guess if youre the only asian store in Davis you can pretty much do whatever you want. This wont really deter me from returning, but I will definitely not smile and try to be nice any longer. Users/Jshpoly

20110324 16:37:41 nbsp I feel like I should comment on the last entry. It actually sounds to me like she may have been trying to be friendly or making a friendly joke about the sushi (which then became awkward when the person didnt catch it). Theres cultural differences that Im used to, but some people find it offputting. I dont know if she thought the snatching was rude either, she probably just didnt want you to put it back if the avocado was bad so she grabbed it. Maybe she WAS actually trying to be rude, but I couldnt quite catch that from the comment made if it was intentional or not.

Anyway, as far as my experiences, I usually dont talk to anyone in there, just grab my stuff and go. But they seem polite and friendly enough, and Im glad we have one asian store in town! Users/Ravyn

20110327 04:02:47 nbsp I love this place. Ive never had anything but positive experiences there in the several years Ive been regularly visiting. I usually pick up a couple sushi packs and some aloe drinks (or lychee Calpico if I really have a sugar craving)and I try to grab something new or interesting whenever I go in, just for the heck of it. Its good cheap eats and fills ME up for under $10, which is saying something. Ive never had anything but polite, prompt service and I can only see most of the complaints on here as being rather trite. Im definitely a satisfied regular customer. Users/KBathory

20110525 22:51:07 nbsp Its interesting reading some of the comments here. I actually thought the lady that worked there was great. Last time I visited I did my usual order of Spicy Tuna + Regular Gimbap. While I was getting ready to leave, the lady just yelled out Grab a noodle! I was a little confused then, but apparently she is offering me free noodles since it was close to their closing time and they didnt want to give it to waste. Great people overall. :) Users/Wiiman

20110526 22:03:13 nbsp Im leaving Davis soon, and Ill always miss Kims and the friendly owners. And their cheap kimbap rolls and ice creams. Some things may be a bit overpriced compared to bigger stores in San Jose or Sacramento, but this is Davis. I hope Kims stays around for a long time. Users/susiekim

20110803 19:43:22 nbsp Kims is a good place to grab some fresh veggies (in the back!) and Asian snacks like Pocky! I also like to get their Korean sushi and marinated tofu (salty, slightly spicy, and ALL yummy!) Plus, the owner is super nice :) Use cash; support small local businesses! Users/AI

20111209 12:30:44 nbsp Kims mart is where I buy all my ramen. Its a bit more expensive than maruchan, but has better ingredients. My favorite is the miso Sapporo Ichiban. I like to cook it on the stove top and add a bit of organic cornstarch, eggs, and red pepper to make a spicy egg blossom soup. Considering the small size of the store, their selection is nothing short of amazing. I do wish that they stocked Mama brand noodles (Tom Yum! Yum yum yum), and Indomie brand mi goreng (my ultimate ultimate fave), but I hope if I stalk the store enough that one day these two magically delicious items will pop up on the shelves as so many other things do. Ive noticed that the Korean products tend to be cheaper than some of the other products, which is fine by me, because Ive sampled a lot of those goodies  like the Milkis carbonated drinks, or the Melona pops, or the Pepero pocky  and found them absolutely amazing.

Regarding the niceness of the cashiers, Ive always found them very friendly, if somewhat reserved. I suspect that theres some cultural differences that may account for this. The man is more overtly friendly than the lady but I have never received bad customer service from either of them.

The kimbap is good. Really good. Whenever Im on a time crunch I always stop by here for some Korean sushi and go on a massive snarfing spree. Also, their drinks are pretty cheap. They have canned sodas, coffee, teas (including Oolong and Jasmine, yum!), aloe, grass jelly, calpico, ramune, and basically every other stereotypical Asian drink you can think of. I think I saw Pokari Sweat lurking in the top left corner: a popular Japanese sports drink.

I love Kims! Users/nutmeg

20120409 22:58:16 nbsp Just excellent for semiprepped Korean food where you can cook the rest at home. And awesome rolls for lunch. Users/MelannieLavarias

20120424 00:17:13 nbsp Went there today to see if they sold banana milk. They didnt have any, so I decided to get some kimbap instead. I didnt realize that I forgot my wallet in my tote bag at home until I got to the counter... there was a line behind me. With no choice, I sheepishly said that Ill put the kimbap back, but Mr. Kim was so nice. He told me to take it and pay them back when I can. I adamantly refused, but he wouldnt take No for an answer, saying that I need(ed) to eat. Ive never experienced such hospitality, and Im no stranger to Mom & Pop Asian stores. I literally wanted to reach over the counter and give him a bear hug. Btdubs, the kimbap is priced SO cheaply. I <3 Kims Mart :) And Ill be back! Users/DianaNguyen

20120513 16:41:05 nbsp Its like the ONLY Asian grocery store in Davis. Small but has a lot of things you usually would see at Asian stores, just things are overpriced compared to the usual Asian stores I would be used to from Sac. Funny story I remember was when I bought my things for $3.99 and I gave the guy $4 and he didnt give me my penny back and I stood there for awhile waiting for my penny. He didnt do anything and didnt look at me. It was only a penny...so whatever right? Users/JaceWinter
 They round change both ways, so sometimes you get extra money, too. If its a big deal, just ask for proper change.

20120727 13:36:33 nbsp superb. i only realized that they had sushi at such a cheap price after checking this site out and i stopped by to grab some.. haha. i am not complaining as the overall quantity is a fantastic deal, but i think it is worth mentioning that sushi rolls (at least the california rolls) are half the size of a normal sushi roll. Users/ljohnny

20121211 14:04:48 nbsp Not sure when it started, but Kims now sells a selection of hot foods to go over to the left of the counter. Users/Michi

20130426 15:19:09 nbsp Very yummy kimbap.

Quick story: only had card, $10 minimum, I only wanted kimbap. The owner told me dont worry about it and let me go off with the food even though I insisted on buying other things. I came to Kims Mart a couple weeks later (it was summer vacation so I was not around) and paid the money that I owed. The owner forgot and thanked me for my honesty.

VERY KIND PEOPLE! And delicious togo food.  Users/DavisKid08

20140507 21:46:38 nbsp When I came in today, the woman at the cash register (whom I assume is the owner) was talking on the phone the entire time while she rung up my purchase. I dont know about anyone else, but I found that unsettling. I mean, if customers are expected to put their phone down when theyre at the cash register, shouldnt the cashier be expected to do the same? I also wish the items I bought were put into two bags instead of one. I bought a lot of stuff, so I had to take half of my purchase and put them into my backpack so that the bag doesnt rip from all that weight while I walked to the bus stop. That said, this place has a decent supply of Asian food, and I managed to find my childhood favourite jelly fruit cups here.  Users/MichelleNguyen

20140707 08:05:15 nbsp I got food poisoning from the Kimchi a few months ago. Not fun. Users/ToddKaiser

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


text:
 General Information
 About Me
 Current
Hi! Im Oleg (pronounced OhLeg). Im an alumni of UC Davis and I never know what to put in an About Me section. P
P.S. This page is probably quite a bit out of date, since I no longer reside in Davis.
 Education
I graduated as a Computer Science CSE major, though have interests spread across various other (mostly engineeringrelated) topics such as Physics, Mathematics, Mechanical Engineering, Philosophy, Psychology, etc...
Although Im not yet sure as to which area in wiki:wikipedia:Computer Science Im going to be specializing in, I have a very wide spread interest ranging from common things like wiki:wikipedia:Programming, to rarer fascinations such as wiki:wikipedia:Computer Security or wiki:wikipedia:Artificial Intelligence, to rather unusual hobbies such as clientside (read: legal) wiki:wikipedia:Hacker (programmer subculture) Memory Editing and finally to the absurdly ridiculous such as wiki:wikipedia:Pixel Art.
I would have happily minored in Physics or perhaps a foreign language (wiki:wikipedia:Korean Language Korean, wiki:wikipedia:Japanese Language Japanese, wiki:wikipedia:French Language French in that order), if I had enough time or units to accomplish this in four years, but for the better or worse, Computer Science CSE has a very full curriculum.

My classes:
 Athletics
I love sports and Exercise exercising in general, but theres of course certain activities that attract me more than others.
I am addicted to martial arts, particularly #head261b9b7670bda3ab104558a83dd2fc9dbc6e9e3b Tae Kwon Do which gets #head261b9b7670bda3ab104558a83dd2fc9dbc6e9e3b its own section. I also actively practice Kung Fu Wushu with the Kung Fu Club UC Davis Wushu Club. I have also, in the past, practiced Judo, Hapkido (Korean Aikido), Kumdo (Korean Kendo), Sambo, Short Staff Combat, Nunchaku Combat and GrecoRoman Wrestling (Who Hasnt...).
In high school, during my junior I joined the cross country team. I got really into running and at my top shape ran a 2miler in 10:40 (which would be a little over
5minute mile time for a single mile). Unfortunately I injured my knee during fall of senior year and had to sit the entire season out. Due to this Im now fairly slow (by my own standards at least), and dont run nearly as much as before. However, Im still addicted to Asics running shoes. )
#head41b94d54dc4e7a3c0c13712339c798c60ac37084 Biking is a more recent fascination which also has its #head41b94d54dc4e7a3c0c13712339c798c60ac37084 own section.
Besides these I really enjoy an occasional game of table tennis (A.K.A. pingpong) and Badminton. I love swimming but prefer to do it in rivers.
 History
Im wiki:wikipedia:Russian and was born in what I call the flat, blank, middle of wiki:wikipedia:Siberia. Unlike the common misconception, Siberia is not like wiki:wikipedia:Antarctica, and wiki:wikipedia:penguins would die of heat there. Siberia does not have constant 1,000,000,000 degrees Kelvin (waa...aay below absolute zero) temperatures as some people seem to think. In fact, during winter it gets to about 40 degrees Celsius (40 degrees Fahrenheit), and during the summer up to about 35 degrees Celsius (95 degrees Fahrenheit). I think its a wonderful place to live but unfortunately Russia in a political toilet at the moment, so Im happy that Im in USA (especially since wiki:wikipedia:Obama took office). I moved to the States when I was 10 (A.K.A. year 2000), and have lived in the (southern) bay area from that time until moving to Davis.
 TaeKwonDo
Ive been actively practicing Tae Kwon Do TaeKwonDo since 2003 and currently train with the http://sportclubs.ucdavis.edu/taekwondo/ UC Davis TaeKwonDo Club.
Im currently a http://www.kukkiwon.or.kr/english/index.jsp Kukkiwon (http://www.wtf.org/wtf_eng/main/main_eng.html World TaeKwonDo Federation Headquarters) certified second Dan black belt.
Im also the webmaster for the http://nctausa.com/ National Collegiate Taekwondo Association.
TaeKwonDo plays a very large role in my life and is important to me.
 Bikes
Heres a list of my bikes:
 Comments

20090930 10:18:59 nbsp Oleg  I can totally help you out on that bike related wish list.  I have Velocity Deep Vs in white and can lace them to colored IRO, Formula, Dia Compe, Suzue, Dura Ace or even Phil wood hubs.  We do standard lacing patterns or even some crazy ones in colored spokes if you want.  I have white straps too in somas toshis or MKS fit Alphas.  Swing by the shop I have all kinds of stuff at the shop. Users/Aaron.Curtin
  Thank you, Ill definitely swing by APEX when Im ready to purchase. But for now, theyre mostly on the wish list due to financial reasons... Users/Oleg.Lokhvitsky

20101018 12:30:28 nbsp Dude, Oleg! Matloff is A+++++! >O Users/MysticHLE
  20101022 20:41:49 nbsp Haha, no way, waaaaaaay too boring/slow.
 Also, Id only go as far as saying he knows his stats. In comp. sci. hes about 30 years behind...
 But then again, even on RMP.com, his ratings differ like crazy. (Either really bad, or really good.) Users/Oleg.Lokhvitsky

20110131 03:25:54 nbsp I like the Gaia avatar customizations for each category.  Definitely one of the cooler daviswiki profiles :D Users/RyanMeyerhoff
  20110209 08:24:30 nbsp Thanks! D Users/Oleg.Lokhvitsky


submodule (h5fortran) hdf5_read
!! This submodule is for reading HDF5 via submodules
use hdf5, only : h5dget_create_plist_f, &
  h5pget_layout_f, h5pget_chunk_f, &
  h5dget_type_f, h5tget_native_type_f, h5tget_class_f, H5Tget_order_f, h5tget_size_f, &
  H5T_DIR_ASCEND_F

use H5LT, only : h5ltpath_valid_f

implicit none (type, external)

contains

module procedure get_class

call get_dset_class(self, dname, get_class)

end procedure get_class

subroutine get_dset_class(self, dname, class, ds_id, size_bytes)
!! get the dataset class (integer, float, string, ...)
!! {H5T_INTEGER_F, H5T_FLOAT_F, H5T_STRING_F}
class(hdf5_file), intent(in) :: self
character(*), intent(in) :: dname
integer, intent(out) :: class
integer(hid_t), intent(in), optional :: ds_id
integer(size_t), intent(out), optional :: size_bytes

integer :: ierr
integer(hid_t) :: dtype_id, native_dtype_id, dset_id

if(present(ds_id)) then
  dset_id = ds_id
else
  call h5dopen_f(self%lid, dname, dset_id, ierr)
  if(ierr/=0) error stop 'h5fortran:get_class: ' // dname // ' from ' // self%filename
endif

call h5dget_type_f(dset_id, dtype_id, ierr)
if(ierr/=0) error stop 'h5fortran:get_class: dtype_id ' // dname // ' from ' // self%filename

call h5tget_native_type_f(dtype_id, H5T_DIR_ASCEND_F, native_dtype_id, ierr)
if(ierr/=0) error stop 'h5fortran:get_class: native_dtype_id ' // dname // ' from ' // self%filename

!> compose datatype inferred
call h5tget_class_f(native_dtype_id, class, ierr)
if(ierr/=0) error stop 'h5fortran:get_class: class ' // dname // ' from ' // self%filename

if(present(size_bytes)) then
  call h5tget_size_f(native_dtype_id, size_bytes, ierr)
  if(ierr/=0) error stop 'h5fortran:get_class: byte size ' // dname // ' from ' // self%filename
endif

!> close to avoid memory leaks
call h5tclose_f(native_dtype_id, ierr)
if(ierr/=0) error stop 'h5fortran:get_class: closing native dtype ' // dname // ' from ' // self%filename

call h5tclose_f(dtype_id, ierr)
if(ierr/=0) error stop 'h5fortran:get_class: closing dtype ' // dname // ' from ' // self%filename

if(.not.present(ds_id)) then
  call h5dclose_f(dset_id, ierr)
  if(ierr/=0) error stop 'h5fortran:get_class: close dataset ' // dname // ' from ' // self%filename
endif

end subroutine get_dset_class

module procedure get_native_dtype
!! get the dataset variable type:
!! {H5T_NATIVE_REAL, H5T_NATIVE_DOUBLE, H5T_NATIVE_INTEGER, H5T_NATIVE_CHARACTER, H5T_STD_I64LE}

integer :: class
! integer :: order, machine_order
integer(size_t) :: size_bytes

call get_dset_class(self, dname, class, ds_id, size_bytes)

!> endianness and within type casting is handled by HDF5
! call h5tget_order_f(native_dtype_id, order, ierr)
! if(ierr/=0) error stop 'h5fortran:reader: get endianness ' // dname // ' from ' // self%filename
! !> check dataset endianness matches machine (in future, could swap endianness if needed)
! call h5tget_order_f(H5T_NATIVE_INTEGER, machine_order, ierr)
! if(order /= machine_order) error stop 'h5fortran:read: endianness /= machine native: ' &
! // dname // ' from ' // self%filename

if(class == H5T_INTEGER_F) then
  if(size_bytes == 4) then
    get_native_dtype = H5T_NATIVE_INTEGER
  elseif(size_bytes == 8) then
    get_native_dtype = H5T_STD_I64LE
  else
    error stop "h5fortran:get_native_dtype: expected 32-bit or 64-bit integer:" // dname // ' from ' // self%filename
  endif
elseif(class == H5T_FLOAT_F) then
  if(size_bytes == 4) then
    get_native_dtype = H5T_NATIVE_REAL
  elseif(size_bytes == 8) then
    get_native_dtype = H5T_NATIVE_DOUBLE
  else
    error stop "h5fortran:get_native_dtype: expected 32-bit or 64-bit real:" // dname // ' from ' // self%filename
  endif
elseif(class == H5T_STRING_F) then
  get_native_dtype = H5T_NATIVE_CHARACTER
else
  error stop "h5fortran:get_native_dtype: non-handled datatype: " // dname // " from " // self%filename
endif

end procedure get_native_dtype

module procedure hdf_get_ndim
!! get rank or "ndims"
integer :: ier

if(.not.self%is_open) error stop 'h5fortran:read: file handle is not open'

drank = -1

if (self%exist(dname)) then
  call h5ltget_dataset_ndims_f(self%lid, dname, drank, ier)
else
  write(stderr, '(a)') 'ERROR:get_ndim: ' // dname // ' does not exist in ' // self%filename
endif

end procedure hdf_get_ndim

module procedure hdf_get_shape
!! must get dims before info, as "dims" must be allocated or segfault occurs.
integer(SIZE_T) :: type_size
integer :: type_class, drank, ier

if(.not. self%exist(dname)) error stop 'h5fortran:get_shape: ' // dname // ' does not exist in ' // self%filename

call h5ltget_dataset_ndims_f(self%lid, dname, drank, ier)
if (ier /= 0) error stop "h5fortran:get_shape: could not get rank of " // dname // " in " // self%filename

allocate(dims(drank))
call h5ltget_dataset_info_f(self%lid, dname, dims=dims, &
  type_class=type_class, type_size=type_size, errcode=ier)
if (ier /= 0) error stop "h5fortran:get_shape: could not get info: " // dname // ' from ' // self%filename

end procedure hdf_get_shape

module procedure hdf_get_chunk

integer :: ierr, drank
integer(HID_T) :: pid, dset_id

if(.not.self%is_open) error stop 'h5fortran:read: file handle is not open'

chunk_size = -1
if (.not.self%exist(dname)) then
  write(stderr, *) 'ERROR:get_chunk: ' // dname // ' does not exist in ' // self%filename
  ierr = -1
  return
endif

if(.not.self%is_chunked(dname)) return

call h5ltget_dataset_ndims_f(self%lid, dname, drank, ierr)
if (check(ierr, 'ERROR:get_chunk: get rank ' // dname // ' ' // self%filename)) return
call h5dopen_f(self%lid, dname, dset_id, ierr)
if (check(ierr, 'ERROR:get_chunk: open dataset ' // dname // ' ' // self%filename)) return
call h5dget_create_plist_f(dset_id, pid, ierr)
if (check(ierr, 'ERROR:get_chunk: get property list ID ' // dname // ' ' // self%filename)) return

call h5pget_chunk_f(pid, drank, chunk_size, ierr)
if (ierr /= drank) then
  write(stderr,*) 'ERROR:get_chunk read ' // dname // ' ' // self%filename
  return
endif

call h5dclose_f(dset_id, ierr)
if (check(ierr, 'ERROR:get_chunk: close dataset: ' // dname // ' ' // self%filename)) return

end procedure hdf_get_chunk

module procedure hdf_get_layout

integer(HID_T) :: pid, dset_id
integer :: ierr

if(.not.self%is_open) error stop 'h5fortran:read: file handle is not open'

layout = -1

if (.not.self%exist(dname)) then
  write(stderr, *) 'ERROR:get_layout: ' // dname // ' does not exist in ' // self%filename
  return
endif

call h5dopen_f(self%lid, dname, dset_id, ierr)
if (check(ierr, 'ERROR:get_layout: open dataset ' // dname // ' ' // self%filename)) return
call h5dget_create_plist_f(dset_id, pid, ierr)
if (check(ierr, 'ERROR:get_layout: get property list ID ' // dname // ' ' // self%filename)) return
call h5pget_layout_f(pid, layout, ierr)
if (check(ierr, 'ERROR:get_layout read ' // dname //' ' // self%filename)) return
call h5dclose_f(dset_id, ierr)
if (check(ierr, 'ERROR:get_layout: close dataset: ' // dname //' ' // self%filename)) return

end procedure hdf_get_layout

module procedure hdf_check_exist

integer :: ierr

if(.not.self%is_open) error stop 'h5fortran:exist: file handle is not open'

call h5ltpath_valid_f(self%lid, dname, .true., hdf_check_exist, ierr)
!! h5lexists_f can false error with groups--just use h5ltpath_valid

if (ierr/=0) error stop 'h5fortran:check_exist: could not determine status of ' // dname // ' in ' // self%filename

end procedure hdf_check_exist

end submodule hdf5_read


text:
program test
  use mpi
  implicit none
  integer                  :: N
  integer                  :: context, n_proc_rows, n_proc_cols
  integer                  :: n_rows, n_cols
  integer                  :: row_blocks_per_proc, col_blocks_per_proc, block_size
  integer                  :: rows_per_proc, cols_per_proc
  integer                  :: row_id, col_id
  integer                  :: i, j, k, tmp, info, n_repeats
  integer, dimension(9)    :: array_desc_a, array_desc_b, array_desc_c
  real, allocatable        :: a(:, :), b(:, :), c(:, :)
  real                     :: pslatra, trace
  integer                  :: start, finish
  real                     :: count_rate
  character(len=50)        :: buffer
  integer                  :: n_procs, ierr

  call GET_COMMAND_ARGUMENT(1, buffer)
  read (buffer, '(i10)') N
  n_rows = N
  n_cols = N

  call MPI_Init(ierr)
  call MPI_Comm_size(MPI_COMM_WORLD, n_procs, ierr)
  n_proc_rows = sqrt(real(n_procs))
  n_proc_cols = n_proc_rows

  call GET_COMMAND_ARGUMENT(2, buffer)
  read (buffer, '(i10)') block_size

  call SL_INIT(context, n_proc_rows, n_proc_cols)

  call blacs_gridinfo(context, n_proc_rows, n_proc_cols, row_id, col_id)

  rows_per_proc = n_rows/n_proc_rows
  cols_per_proc = n_cols/n_proc_cols
  row_blocks_per_proc = rows_per_proc/block_size
  col_blocks_per_proc = cols_per_proc/block_size

  call descinit(array_desc_a, n_rows, n_cols, block_size, block_size, 0, 0, context, row_blocks_per_proc*block_size, info)
  call descinit(array_desc_b, n_rows, n_cols, block_size, block_size, 0, 0, context, row_blocks_per_proc*block_size, info)
  call descinit(array_desc_c, n_rows, n_cols, block_size, block_size, 0, 0, context, row_blocks_per_proc*block_size, info)

  ! a(:, :) = 1
  ! b(:, :) = 1

  ! if (row_id .eq. 0 .and. col_id .eq. 0) then
  !    a(2, 2) = 5
  ! endif

  ! write (*,*) a
  ! trace = pslatra(n_rows, a, 1, 1, array_desc_a)
  ! if (row_id .eq. 0 .and. col_id .eq. 0) then
  !    write (*,*) 'trace ', trace
  ! endif

  ! k = 1
  ! do j = 1, row_blocks_per_proc
  !    do i = 1, block_size
  !       tmp = i+(j-1)*block_size*row_blocks_per_proc + row_id * block_size
  !       a(k, :) = tmp - 1
  !       b(k, :) = tmp
  !       k = k + 1
  !    enddo
  ! enddo

  ! do i = 1, rows_per_proc
  !    a(i, :) = i - 1 + block_size*row_id
  !    b(i, :) = i + block_size*row_id
  ! enddo

  call SYSTEM_CLOCK(start)

  allocate (a(rows_per_proc, cols_per_proc), &
       b(rows_per_proc, cols_per_proc), &
       c(rows_per_proc, cols_per_proc))

  call RANDOM_NUMBER(a)
  call RANDOM_NUMBER(b)
  call psgemm('N', 'N', n_rows, n_cols, n_cols, 1.0, &
       a, 1, 1, array_desc_b, &
       b, 1, 1, array_desc_a, &
       0.0, c, 1, 1, array_desc_c)
  trace = pslatra(n_rows, c, 1, 1, array_desc_c)
  deallocate (a, b, c)
  call SYSTEM_CLOCK(finish, count_rate)

  if (row_id .eq. 0 .and. col_id .eq. 0) then
     write (*, *) (finish - start) / count_rate
  endif

  ! ! write (*, *) 'after', row_id, col_id, c
  ! if (row_id .eq. 0 .and. col_id .eq. 0) then
  !    write (*, *) 'after'
  !    write (*, *) c
  ! endif

  CALL BLACS_GRIDEXIT(context)
  call BLACS_EXIT(0)

endprogram test

max_stars_repo_name: cc-a/dask-comparison

max_issues_repo_name: cc-a/dask-comparison

max_forks_repo_name: cc-a/dask-comparison


text:
      INTEGER FUNCTION mltmod(a,s,m)
C**********************************************************************
C
C     INTEGER FUNCTION MLTMOD(A,S,M)
C
C                    Returns (A*S) MOD M
C
C     This is a transcription from Pascal to Fortran of routine
C     MULtMod_Decompos from the paper
C
C     L'Ecuyer, P. and Cote, S. "Implementing a Random Number Package
C     with Splitting Facilities." ACM Transactions on Mathematical
C     Software, 17:98-111 (1991)
C
C
C                              Arguments
C
C
C     A, S, M  -->
C                         INTEGER A,S,M
C
C**********************************************************************
C     .. Parameters ..
      INTEGER h
      PARAMETER (h=32768)
C     ..
C     .. Scalar Arguments ..
      INTEGER a,m,s
C     ..
C     .. Local Scalars ..
      INTEGER a0,a1,k,p,q,qh,rh
C     ..
C     .. Executable Statements ..
C
C     H = 2**((b-2)/2) where b = 32 because we are using a 32 bit
C      machine. On a different machine recompute H
C
      IF (.NOT. (a.LE.0.OR.a.GE.m.OR.s.LE.0.OR.s.GE.m)) GO TO 10
      WRITE (*,*) ' A, M, S out of order in MLTMOD - ABORT!'
      WRITE (*,*) ' A = ',a,' S = ',s,' M = ',m
      WRITE (*,*) ' MLTMOD requires: 0 < A < M; 0 < S < M'
      STOP ' A, M, S out of order in MLTMOD - ABORT!'

   10 IF (.NOT. (a.LT.h)) GO TO 20
      a0 = a
      p = 0
      GO TO 120

   20 a1 = a/h
      a0 = a - h*a1
      qh = m/h
      rh = m - h*qh
      IF (.NOT. (a1.GE.h)) GO TO 50
      a1 = a1 - h
      k = s/qh
      p = h* (s-k*qh) - k*rh
   30 IF (.NOT. (p.LT.0)) GO TO 40
      p = p + m
      GO TO 30

   40 GO TO 60

   50 p = 0
C
C     P = (A2*S*H)MOD M
C
   60 IF (.NOT. (a1.NE.0)) GO TO 90
      q = m/a1
      k = s/q
      p = p - k* (m-a1*q)
      IF (p.GT.0) p = p - m
      p = p + a1* (s-k*q)
   70 IF (.NOT. (p.LT.0)) GO TO 80
      p = p + m
      GO TO 70

   80 CONTINUE
   90 k = p/qh
C
C     P = ((A2*H + A1)*S)MOD M
C
      p = h* (p-k*qh) - k*rh
  100 IF (.NOT. (p.LT.0)) GO TO 110
      p = p + m
      GO TO 100

  110 CONTINUE
  120 IF (.NOT. (a0.NE.0)) GO TO 150
C
C     P = ((A2*H + A1)*H*S)MOD M
C
      q = m/a0
      k = s/q
      p = p - k* (m-a0*q)
      IF (p.GT.0) p = p - m
      p = p + a0* (s-k*q)
  130 IF (.NOT. (p.LT.0)) GO TO 140
      p = p + m
      GO TO 130

  140 CONTINUE
  150 mltmod = p
C
      RETURN

      END

max_stars_repo_name: ppernot/MC-ChemDB

max_issues_repo_name: ppernot/MC-ChemDB

max_forks_repo_name: ppernot/MC-ChemDB


text:
      subroutine gg_h_gs(p,msq)
c---Matrix element SUBTRACTION squared averaged over initial colors and spins
c----for H production
c----in the heavy quark (mt=Infinity) limit.
C----averaged over initial colours and spins
c     g(-p1)+g(-p2)-->H --> (b(p3)+b~(p4))+g(p5)
c---
      implicit none
      include 'constants.f'
      include 'ptilde.f'
      include 'qqgg.f'
      integer j,k,nd

      double precision p(mxpart,4),msq(maxd,-nf:nf,-nf:nf)
      double precision msq17_2(-nf:nf,-nf:nf),msq27_1(-nf:nf,-nf:nf),
     . msq17_2v(-nf:nf,-nf:nf),msq27_1v(-nf:nf,-nf:nf),
     . sub17_2(4),sub27_1(4),sub17_2v,sub27_1v
      external gg_h,gg_h_gvec
      integer iglue
      parameter(iglue=5)
      ndmax=2

c---- calculate both initial-initial dipoles
c---- note that we do not require the gg dipoles, so the v-type
c---- entries are left as dummies
      call dips(1,p,1,iglue,2,sub17_2,sub17_2v,msq17_2,msq17_2v,
     . gg_h,gg_h_gvec)
      call dips(2,p,2,iglue,1,sub27_1,sub27_1v,msq27_1,msq27_1v,
     . gg_h,gg_h_gvec)

      do j=-nf,nf
      do k=-nf,nf
      do nd=1,ndmax
      msq(nd,j,k)=0d0
      enddo

      if     ((j .ne. 0) .and. (k .eq. 0)) then
         msq(1,j,k)=2d0*cf
     .   *(msq17_2(0,0)*sub17_2(gq)+msq17_2v(0,0)*sub17_2v)
      elseif ((j .eq. 0) .and. (k .ne. 0)) then
         msq(2,j,k)=2d0*cf
     .   *(msq27_1(0,0)*sub27_1(gq)+msq27_1v(0,0)*sub27_1v)
      elseif ((j .eq. 0) .and. (k .eq. 0)) then
         msq(1,j,k)=2d0*xn
     .   *(msq17_2(j,k)*sub17_2(gg)+msq17_2v(j,k)*sub17_2v)
         msq(2,j,k)=2d0*xn
     .   *(msq27_1(j,k)*sub27_1(gg)+msq27_1v(j,k)*sub27_1v)
      endif

      enddo
      enddo

      return
      end

max_stars_repo_name: tmartini/JHUGen

max_issues_repo_name: tmartini/JHUGen

max_forks_repo_name: tmartini/JHUGen


text:
!!  Copyright (C)  Stichting Deltares, 2012-2016.
!!
!!  This program is free software: you can redistribute it and/or modify
!!  it under the terms of the GNU General Public License version 3,
!!  as published by the Free Software Foundation.
!!
!!  This program is distributed in the hope that it will be useful,
!!  but WITHOUT ANY WARRANTY; without even the implied warranty of
!!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
!!  GNU General Public License for more details.
!!
!!  You should have received a copy of the GNU General Public License
!!  along with this program. If not, see <http://www.gnu.org/licenses/>.
!!
!!  contact: delft3d.support@deltares.nl
!!  Stichting Deltares
!!  P.O. Box 177
!!  2600 MH Delft, The Netherlands
!!
!!  All indications and logos of, and references to registered trademarks
!!  of Stichting Deltares remain the property of Stichting Deltares. All
!!  rights reserved.

      subroutine rear   ( pmsa   , fl     , ipoint , increm , noseg  ,
     &                    noflux , iexpnt , iknmrk , noq1   , noq2   ,
     &                    noq3   , noq4   )
!>\file
!>       Reaeration of carbon dioxide and oxygen

!
!     Description of the module :
!
! Name    T   L I/O   Description                                   Units
! ----    --- -  -    -------------------                            ----
! DEPTH   R*4 1 I actual depth of the water column                     [m]
! FCOVER  R*4 1 I fraction of water surface covered <0-1>              [-]
! FL (1)  R*4 1 O reaeration flux                                 [g/m3/d]
! HCRT    R*4 1 I critical water depth/velocity                        [m]
! IFREAR  I*4 1 I switch for the rearation formula                     [-]
! MAXRRC  R*4 1 I maximum wat trf. coef. for temp. lim.              [m/d]
! MINRRC  R*4 1 I minimum reaeration rate                            [m/d]
! O2      R*4 1 I concentration of dissolved oxygen                 [g/m3]
! OXSAT   R*4 1 L saturation concentration of dissolved oxygen      [g/m3]
! RAIN    R*4 1 L rainfall rate                                     [mm/h]
! REARTC  R*4 1 L reaeration temperatuur coefficient                   [-]
! REARKL  R*4 1 L reaeration transfer coefficient                    [m/d]
! REARRC  R*4 1 L reaeration rate                                    [1/d]
! TEMP    R*4 1 I ambient temperature                                 [xC]
! TEMP20  R*4 1 L ambient temperature - stand. temp (20)              [xC]
! VELOC   R*4 1 I streamflow velocity                                [m/s]
! VWIND   R*4 1 I wind velocity                                      [m/s]

!     Logical Units : -

!     Modules called : -

!     Name     Type   Library
!     ------   -----  ------------

      IMPLICIT NONE

      REAL     PMSA  ( * ) , FL    (*)
      INTEGER  IPOINT( * ) , INCREM(*) , NOSEG , NOFLUX,
     +         IEXPNT(4,*) , IKNMRK(*) , NOQ1, NOQ2, NOQ3, NOQ4
!
!     Local declarations
!
      INTEGER  IFREAR, IKMRK1, IKMRK2, ISEG, IFLUX
      INTEGER  IP1 , IP2 , IP3 , IP4 , IP5 , IP6 , IP7 , IP8, IP9, IP10,
     +         IP11, IP12, IP13, IP14, IP15, IP16, IP17, IP18,IP19,IP20,
     +         IP21, IP22, IP23, IP24, IP25, IP26, IP27
      REAL     SAL   , B_ENHA, SC    , SC20  , KLREAR, TOTDEP,
     +         REARTC, REARRC, HCRT  , VELOC , VWIND , TEMP  ,
     +         OXSAT , O2    , TEMP20, TMPCF , DEPTH , FL1   ,
     +         FCOVER, MAXRRC, REARKL, SATPERC,MINRRC, DELT  , RAIN
      REAL     A     , B1    , B2    , C1    ,
     +         C2    , D1    , D2    , D3    , D4  ,
     +         D1Os  , D2Os  , D3Os  , D4Os  ,
     +         D1Cs  , D2Cs  , D3Cs  , D4Cs  ,
     +         D1Hs  , D2Hs  , D3Hs  , D4Hs

!   PBo3: hard coded original coefficients -> user defined input
!     Parameters for Schmidt number calculation (Warninkhoff and Guerin)
!     A1-D1=oxygen Wannikhof (seawater)
!     A2-D2=oxygen Gerin and Wannikhof (both fresh)
!     A3-D3=CO2 Wannikhof (seawater)
!     A4-D4=CO2 Gerin and Wannikhof (both fresh)
!     A5-D5= reserved for CH4 seawater
!     A6-D6=CH4 freshwater

!      PARAMETER ( A1 = 1953.4     ,
!    +            B1 =  128.00    ,
!    +            C1 =    3.9918  ,
!    +            D1 =    0.050091,
!    +            A2 = 1800.6     ,
!    +            B2 =  120.10    ,
!    +            C2 =    3.7818  ,
!    +            D2 =    0.047608,
!    +            A3 = 2073.1     ,
!    +            B3 =  125.62    ,
!    +            C3 =    3.6276  ,
!    +            D3 =    0.043219,
!    +            A4 = 1911.1     ,
!    +            B4 =  118.11    ,
!    +            C4 =    3.4527  ,
!    +            D4 =    0.04132 ,
!    +            A6 = 1897.8     ,
!    +            B6 =  114 .28   ,
!    +            C6 =    3.2902  ,
!    +            D6 =    0.039061 )

!   PBo3: hard coded coefficients for salt water options Wannikhof
!     Parameters for Schmidt number calculation (Wanninkhoff and Guerin)
!     D1-4Os = oxygen Wannikhof (seawater)
!     D1-4Cs = CO2 Wannikhof (seawater)
!     D1-4Hs = dummy values for CH4 seawater

      PARAMETER ( D1Os = 1953.4     ,
     +            D2Os =  128.00    ,
     +            D3Os =    3.9918  ,
     +            D4Os =    0.050091,
     +            D1Cs = 2073.1     ,
     +            D2Cs =  125.62    ,
     +            D3Cs =    3.6276  ,
     +            D4Cs =    0.043219,
     +            D1Hs = 2073.1     ,
     +            D2Hs =  125.62    ,
     +            D3Hs =    3.6276  ,
     +            D4Hs =    0.043219   )

      IP1  = IPOINT( 1)
      IP2  = IPOINT( 2)
      IP3  = IPOINT( 3)
      IP4  = IPOINT( 4)
      IP5  = IPOINT( 5)
      IP6  = IPOINT( 6)
      IP7  = IPOINT( 7)
      IP8  = IPOINT( 8)
      IP9  = IPOINT( 9)
      IP10 = IPOINT(10)
      IP11 = IPOINT(11)
      IP12 = IPOINT(12)
      IP13 = IPOINT(13)
      IP14 = IPOINT(14)
      IP15 = IPOINT(15)
      IP16 = IPOINT(16)
      IP17 = IPOINT(17)
      IP18 = IPOINT(18)
      IP19 = IPOINT(19)
      IP20 = IPOINT(20)
      IP21 = IPOINT(21)
      IP22 = IPOINT(22)
      IP23 = IPOINT(23)
      IP24 = IPOINT(24)
      IP25 = IPOINT(25)
      IP26 = IPOINT(26)
      IP27 = IPOINT(27)

!
      IFLUX = 0
      DO 9000 ISEG = 1 , NOSEG
      CALL DHKMRK(1,IKNMRK(ISEG),IKMRK1)
      IF (IKMRK1.EQ.1) THEN
!     als ook rekenen voor drooggevallen platen dan :
!jvb  IF (IKMRK1.EQ.0.OR.IKMRK1.EQ.1) THEN

!         Compute saturation percentage for all layers

      O2     = PMSA(IP1 )
      OXSAT  = PMSA(IP10 )
      SATPERC = O2 / OXSAT * 100
      PMSA (IP27) = SATPERC

      CALL DHKMRK(2,IKNMRK(ISEG),IKMRK2)
      IF ((IKMRK2.EQ.0).OR.(IKMRK2.EQ.1)) THEN
!
      DEPTH  = PMSA(IP2 )
      TEMP   = PMSA(IP3 )
      VELOC  = PMSA(IP4 )
      VWIND  = PMSA(IP5 )
      IFREAR = PMSA(IP6 ) + 0.5
      REARKL = PMSA(IP7 )
      REARTC = PMSA(IP8 )
      DELT   = PMSA(IP9  )
      SAL    = PMSA(IP11 )
      TOTDEP = PMSA(IP12 )
      FCOVER = PMSA(IP13 )
      MAXRRC = PMSA(IP14 )
      MINRRC = PMSA(IP15 )
      RAIN   = PMSA(IP16 )
      A      = PMSA(IP17 )
      B1     = PMSA(IP18 )
      B2     = PMSA(IP19 )
      C1     = PMSA(IP20 )
      C2     = PMSA(IP21 )
      D1     = PMSA(IP22 )
      D2     = PMSA(IP23 )
      D3     = PMSA(IP24 )
      D4     = PMSA(IP25 )

      IF (DEPTH   .LT. 1E-30) CALL ZEROME ('DEPTH in REAR')

!     JvG, 1 May 2002
!     Current formulation was not valid for layered schematisations
!     Correct by using the methodology as follows:
!     a) compute surface transfer coefficient in m/day per method
!     b) compute flux by multiplying with (surface) deficit
!     c) convert to volumetric flux by using the (surface) layer thickness

      IF (IFREAR .EQ. 0) THEN
!
!         0. Unscaled user input coefficient in 1/day
!
          REARRC = REARKL * TOTDEP

      ELSEIF (IFREAR .EQ. 1) THEN
!
!         1. User input coefficient in m/day
!
          REARRC = REARKL

      ELSEIF (IFREAR .EQ. 2) THEN
!
!         2. Churchill [1962]
!
          REARRC = 0.0
          IF (VELOC  .GT. 1E-30)
     J    REARRC = 5.026 * (VELOC**0.969) / (TOTDEP**0.673)

      ELSEIF (IFREAR .EQ. 3) THEN
!
!         3. O'Connor - Dobbins [1958]
!
          REARRC = 0.0
          IF (VELOC  .GT. 1E-30)
     J    REARRC = 3.863 * (VELOC**0.5) / (TOTDEP**0.5)

      ELSEIF (IFREAR .EQ. 4) THEN
!
!         4. Scaled version of O'Connor - Dobbins [1958]
!
          REARRC = 0.0
          IF (VELOC  .GT. 1E-30)
     J    REARRC = 3.863 * (VELOC**0.5) / (TOTDEP**0.5) * REARKL

      ELSEIF (IFREAR .EQ. 5) THEN
!
!         5. Owens - Edwards - Gibb [1964]
!
          REARRC = 0.0
          IF (VELOC  .GT. 1E-30)
     J    REARRC = 5.322 * (VELOC**0.67) / (TOTDEP**0.85)

      ELSEIF (IFREAR .EQ. 6) THEN
!
!         6. Langbien - Durum [1967]
!
          REARRC = 0.0
          IF (VELOC  .GT. 1E-30)
     J    REARRC = 11.23 * VELOC / (TOTDEP**0.333)

      ELSEIF (IFREAR .EQ. 7) THEN
!
!         7. Van Pagee[1978] and Delvigne [1980]
!
          IF (VELOC  .GT. 1E-30) THEN
              REARRC = ( REARKL * 0.065 * VWIND**2 +
     &               3.86  * SQRT( VELOC/TOTDEP ) )
          ELSE
              REARRC = REARKL* 0.065 * VWIND**2
          ENDIF

      ELSEIF (IFREAR .EQ. 8) THEN
!
!         8. Thackston - Krenkel [1966]
!
          WRITE (*,*) ' Reaeration formula 8 has not been implemented'
          CALL SRSTOP(1)

      ELSEIF (IFREAR .EQ. 9) THEN
!
!         9. DBS
!
          REARRC = ( 0.30 + REARKL * 0.028 * VWIND**2 )

      ELSEIF (IFREAR .EQ. 10) THEN
!
!        10. Wanninkhof Oxygen
!
          IF ( SAL .GT. 5.0 ) THEN
             SC   = D1Os - D2Os*TEMP + D3Os*TEMP**2 - D4Os*TEMP**3
             SC20 = D1Os - D2Os*20.0 + D3Os*20.0**2 - D4Os*20.0**3
          ELSE
             SC   = D1 - D2*TEMP + D3*TEMP**2 - D4*TEMP**3
             SC20 = D1 - D2*20.0 + D3*20.0**2 - D4*20.0**3
          ENDIF
          KLREAR = 0.31*VWIND**2*(SC/SC20)**(-0.5)*24./100.
          REARRC = KLREAR

      ELSEIF (IFREAR .EQ. 11) THEN
!
!        10. Wanninkhof CO2
!
          IF ( SAL .GT. 5.0 ) THEN
             SC   = D1Cs - D2Cs*TEMP + D3Cs*TEMP**2 - D4Cs*TEMP**3
             SC20 = D1Cs - D2Cs*20.0 + D3Cs*20.0**2 - D4Cs*20.0**3
          ELSE
             SC   = D1 - D2*TEMP + D3*TEMP**2 - D4*TEMP**3
             SC20 = D1 - D2*20.0 + D3*20.0**2 - D4*20.0**3
          ENDIF
          B_ENHA = 2.5*(.5246+1.6256E-2*TEMP+4.9946E-4*TEMP**2)
          KLREAR = (B_ENHA + 0.31*VWIND**2)*(SC/SC20)**(-0.5)*24./100.
          REARRC = KLREAR

      ELSEIF (IFREAR .EQ. 12) THEN

!     Note this option is not included in the process documentation!
!
!         12. Hybride formulation using O'Connor - Dobbins [1958]
!             and Owens - Edwards - Gibb [1964]
!
          REARRC = 0.0
          HCRT = 3.93/5.32*TOTDEP**0.35
          IF (VELOC  .GT. 1E-30) THEN
             IF (VELOC .LT. HCRT**6) THEN
                REARRC = 3.93 * (VELOC**0.5) / (TOTDEP**0.5)
             ELSE
                REARRC = 5.32 * (VELOC**0.67) / (TOTDEP**0.85)
             ENDIF
          ENDIF
          REARRC = MAX(MINRRC,REARRC)

      ELSEIF ( IFREAR .EQ. 13) THEN
!
!        13. Guerin O2  - only fresh water
!            Guerin CO2 - only fresh water
!            Guerin CH4 - only fresh water
!
          SC   = D1 - D2*TEMP + D3*TEMP**2 - D4*TEMP**3
          SC20 = D1 - D2*20.0 + D3*20.0**2 - D4*20.0**3

          KLREAR =(A*EXP(B1 * VWIND**B2)+C1*Rain**C2)*(SC/SC20)**(-0.67)
          REARRC = KLREAR

          REARTC = 1.0
!
      ELSE
          WRITE (*,*) ' Illegal option for reaeration formula'
          CALL SRSTOP(1)
      ENDIF

      PMSA (IP26 ) = REARRC/DEPTH

!     Calculation of rearation flux ( M.L-1.DAY)
!     negatieve zuurstof wordt 0 gemaakt i.v.m. deficiet berekening!
!     Wanninkhof, don't use temperature dependency

      O2 = MAX (O2, 0.0)
      IF ( IFREAR .EQ. 10 .OR. IFREAR .EQ. 11 ) THEN
         FL1 = REARRC * ( OXSAT - O2 ) / DEPTH
      ELSE
         TEMP20 = TEMP - 20.0
         TMPCF  = REARTC ** TEMP20
         IF (REARRC.LE.MAXRRC) THEN
            REARRC = REARRC * TMPCF
         ENDIF
         FL1 = MIN( 1.0 / DELT, REARRC * (1-FCOVER)/DEPTH ) * (OXSAT-O2)
      ENDIF

!     Limitation of FL(1) to amount of oxygen present
      IF (FL1 .LT. 0.0 ) THEN
          FL1 = MAX (-1.*O2/DELT,  FL1 )
      ENDIF
      FL( 1+IFLUX) = FL1

      ENDIF
      ENDIF
!
      IFLUX = IFLUX + NOFLUX
      IP1   = IP1   + INCREM (  1 )
      IP2   = IP2   + INCREM (  2 )
      IP3   = IP3   + INCREM (  3 )
      IP4   = IP4   + INCREM (  4 )
      IP5   = IP5   + INCREM (  5 )
      IP6   = IP6   + INCREM (  6 )
      IP7   = IP7   + INCREM (  7 )
      IP8   = IP8   + INCREM (  8 )
      IP9   = IP9   + INCREM (  9 )
      IP10  = IP10  + INCREM ( 10 )
      IP11  = IP11  + INCREM ( 11 )
      IP12  = IP12  + INCREM ( 12 )
      IP13  = IP13  + INCREM ( 13 )
      IP14  = IP14  + INCREM ( 14 )
      IP15  = IP15  + INCREM ( 15 )
      IP16  = IP16  + INCREM ( 16 )
      IP17  = IP17  + INCREM ( 17 )
      IP18  = IP18  + INCREM ( 18 )
      IP19  = IP19  + INCREM ( 19 )
      IP20  = IP20  + INCREM ( 20 )
      IP21  = IP21  + INCREM ( 21 )
      IP22  = IP22  + INCREM ( 22 )
      IP23  = IP23  + INCREM ( 23 )
      IP24  = IP24  + INCREM ( 24 )
      IP25  = IP25  + INCREM ( 25 )
      IP26  = IP26  + INCREM ( 26 )
      IP27  = IP27  + INCREM ( 27 )
!
 9000 CONTINUE
!
      RETURN
!
      END

max_stars_repo_name: liujiamingustc/phd

max_issues_repo_name: liujiamingustc/phd

max_forks_repo_name: liujiamingustc/phd


text:
!-----------------------------------------------------------------------
!Module accuracy defines precision and some constants
!-----------------------------------------------------------------------
module accuracy_module
   implicit none
   integer, parameter, public :: rdp = kind(1.d0)
   ! constants
   real(rdp), parameter :: pi=3.141592653589793238462643383279502884197_rdp
end module accuracy_module

!-----------------------------------------------------------------------
!Module typedefs_module contains abstract derived type and extended type definitions.
! Note that a reserved word "class" in Fortran is used to describe
! some polymorphic variable  whose data type may vary at run time.
!-----------------------------------------------------------------------
module typedefs_module
   use accuracy_module
   implicit none

   private ! all
   public :: TPoint, TShape, TCircle, TRectangle, TSquare ! public only these defined derived types

   ! abstract derived type
   type, abstract :: TShape
      real(rdp) :: area
      character(len=:),allocatable :: name
   contains
      ! deferred method i.e. abstract method =  must be overridden in extended type
      procedure(calculate_area), deferred,pass :: calculate_area
   end type TShape
   ! just declaration of the abstract method/procedure for TShape type
   abstract interface
      function  calculate_area(this)
         use accuracy_module
         import TShape !imports TShape type from host scoping unit and makes it accessible here
         implicit none
         class(TShape) :: this
         real(rdp) :: calculate_area

      end function calculate_area
   end interface

   ! auxiliary derived type
   type TPoint
      real(rdp) :: x,y
   end type TPoint

   ! extended derived type
   type, extends(TShape) :: TCircle
      real(rdp) :: radius
      real(rdp), private :: diameter
      type(TPoint) :: centre
   contains
      procedure, pass :: calculate_area => calculate_circle_area
      procedure, pass :: get_circle_diameter
      final :: finalize_circle
   end type TCircle

   ! extended derived type
   type, extends(TShape) :: TRectangle
      type(TPoint) :: A,B,C,D
   contains
      procedure, pass :: calculate_area => calculate_rectangle_area
      final :: finalize_rectangle
   end type TRectangle

   ! extended derived type
   type, extends(TRectangle) :: TSquare
   contains
      procedure, pass :: calculate_area => calculate_square_area
      final :: finalize_square
   end type TSquare

 contains

   ! finalization subroutines for each type
   ! They called recursively, i.e. finalize_rectangle
   ! will be called after finalize_square subroutine
   subroutine finalize_circle(x)
      type(TCircle), intent(inout) :: x
      write(*,*) "Deleting TCircle object"
   end subroutine finalize_circle

   subroutine finalize_rectangle(x)
      type(TRectangle), intent(inout) :: x
      write(*,*) "Deleting also TRectangle object"
   end subroutine finalize_rectangle

   subroutine finalize_square(x)
      type(TSquare), intent(inout) :: x
      write(*,*) "Deleting TSquare object"
   end subroutine finalize_square

   function calculate_circle_area(this)
      implicit none
      class(TCircle) :: this
      real(rdp) :: calculate_circle_area
      this%area = pi * this%radius**2
      calculate_circle_area = this%area
   end function calculate_circle_area

   function calculate_rectangle_area(this)
      implicit none
      class(TRectangle) :: this
      real(rdp) :: calculate_rectangle_area
      ! here could be more code
      this%area = 1
      calculate_rectangle_area = this%area
   end function calculate_rectangle_area

   function calculate_square_area(this)
      implicit none
      class(TSquare) :: this
      real(rdp) :: calculate_square_area
      ! here could be more code
      this%area = 1
      calculate_square_area = this%area
   end function calculate_square_area

   function  get_circle_diameter(this)
      implicit none
      class(TCircle) :: this
      real(rdp) :: get_circle_diameter
      this % diameter = 2.0_rdp * this % radius
      get_circle_diameter = this % diameter
   end function get_circle_diameter

end module typedefs_module

!-----------------------------------------------------------------------
!Main program
!-----------------------------------------------------------------------
program    rosetta_class
   use accuracy_module
   use typedefs_module
   implicit none

   ! we need this subroutine in order to show the finalization
   call test_types()

 contains

   subroutine test_types()
      implicit none
      ! declare object of type TPoint
      type(TPoint), target :: point
      ! declare object of type TCircle
      type(TCircle),target :: circle
      ! declare object of type TSquare
      type(TSquare),target :: square

      ! declare pointers
      class(TPoint), pointer :: ppo
      class(TCircle), pointer :: pci
      class(TSquare), pointer :: psq

      !constructor
      point = TPoint(5.d0,5.d0)
      ppo => point
      write(*,*) "x=",point%x,"y=",point%y

      pci => circle

      pci % radius = 1
      write(*,*) pci % radius
      ! write(*,*) pci % diameter !No,it is a PRIVATE component
      write(*,*) pci % get_circle_diameter()
      write(*,*) pci % calculate_area()
      write(*,*) pci % area

      psq => square

      write(*,*) psq % area
      write(*,*) psq % calculate_area()
      write(*,*) psq % area
   end subroutine test_types

end program rosetta_class

max_issues_repo_name: seanwallawalla-forks/RosettaCodeData

max_forks_repo_name: seanwallawalla-forks/RosettaCodeData