text:
!***********************************************************************
!                                                                      *
      SUBROUTINE TALK(JA, JB, NU, IA, IB, IC, ID, ITYPE, COEF)
!                                                                      *
!   Print  coefficients  and  integral  parameters  if IBUG1 > 0 and   *
!   write to disk.                                                     *
!                                                                      *
!                                           Last update: 14 Oct 1992   *
!                                                                      *
!***********************************************************************
!...Translated by Pacific-Sierra Research 77to90  4.3E  15:16:29   1/ 6/07
!...Modified by Charlotte Froese Fischer
!                     Gediminas Gaigalas  10/05/17
!-----------------------------------------------
!   M o d u l e s
!-----------------------------------------------
      USE vast_kind_param, ONLY:  DOUBLE
      USE parameter_def,   ONLY:  KEYORB
      USE BUFFER_C
      USE debug_C
      USE orb_C
!-----------------------------------------------
!   I n t e r f a c e   B l o c k s
!-----------------------------------------------
      USE alcbuf_I
      IMPLICIT NONE
!-----------------------------------------------
!   D u m m y   A r g u m e n t s
!-----------------------------------------------
      INTEGER, INTENT(IN) :: JA, JB, NU, IA, IB, IC, ID, ITYPE
      REAL(DOUBLE), INTENT(IN) :: COEF
!-----------------------------------------------
!   L o c a l   P a r a m e t e r s
!-----------------------------------------------
      INTEGER, PARAMETER :: KEY = KEYORB
!-----------------------------------------------
!   Print coefficient if requested
!
      IF (IBUG1 /= 0) WRITE (99, 300) JA, JB, NP(IA), NH(IA), NP(IB), NH(IB), &
         NP(IC), NH(IC), NP(ID), NH(ID), NU, ITYPE, COEF
!
!   Increment counter
!
      NVCOEF = NVCOEF + 1
!
!   Ensure that arrays are of adequate size; reallocate if necessary
!
      IF (NVCOEF > NBDIM) CALL ALCBUF (2)
!
!   Store integral indices and coefficient in COMMON/BUFFER/
!
      LABEL(1,NVCOEF) = IA
      LABEL(2,NVCOEF) = IB
      LABEL(3,NVCOEF) = IC
      LABEL(4,NVCOEF) = ID
      LABEL(5,NVCOEF) = NU
      LABEL(6,NVCOEF) = ITYPE
      COEFF(NVCOEF) = COEF
!
      RETURN
!
  300 FORMAT(2(1X,1I2),4(1X,I2,A2),1X,1I2,1X,1I2,1X,1P,D19.12)
      RETURN
!
      END SUBROUTINE TALK

max_stars_repo_name: sylas/grasp-continuum

max_issues_repo_name: sylas/grasp-continuum

max_forks_repo_name: sylas/grasp-continuum


text:
      SUBROUTINE INTERP(BUF,T,NCF,NCM,NA,IFL,PV)
C
C+++++++++++++++++++++++++++++++++
C
C     THIS SUBROUTINE DIFFERENTIATES AND INTERPOLATES A
C     SET OF CHEBYSHEV COEFFICIENTS TO GIVE POSITION AND VELOCITY
C
C     CALLING SEQUENCE PARAMETERS:
C
C       INPUT:
C
C         BUF   1ST LOCATION OF ARRAY OF D.P. CHEBYSHEV COEFFICIENTS OF POSITION
C
C           T   T(1) IS DP FRACTIONAL TIME IN INTERVAL COVERED BY
C               COEFFICIENTS AT WHICH INTERPOLATION IS WANTED
C               (0 .LE. T(1) .LE. 1).  T(2) IS DP LENGTH OF WHOLE
C               INTERVAL IN INPUT TIME UNITS.
C
C         NCF   # OF COEFFICIENTS PER COMPONENT
C
C         NCM   # OF COMPONENTS PER SET OF COEFFICIENTS
C
C          NA   # OF SETS OF COEFFICIENTS IN FULL ARRAY
C               (I.E., # OF SUB-INTERVALS IN FULL INTERVAL)
C
C          IFL  INTEGER FLAG: =1 FOR POSITIONS ONLY
C                             =2 FOR POS AND VEL
C
C
C       OUTPUT:
C
C         PV   INTERPOLATED QUANTITIES REQUESTED.  DIMENSION
C               EXPECTED IS PV(NCM,IFL), DP.
C
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
      SAVE
C
      DOUBLE PRECISION BUF(NCF,NCM,*),T(2),PV(NCM,*),PC(18),VC(18)

C
      DATA NP/2/
      DATA NV/3/
      DATA TWOT/0.D0/
      DATA PC(1),PC(2)/1.D0,0.D0/
      DATA VC(2)/1.D0/
C
C       ENTRY POINT. GET CORRECT SUB-INTERVAL NUMBER FOR THIS SET
C       OF COEFFICIENTS AND THEN GET NORMALIZED CHEBYSHEV TIME
C       WITHIN THAT SUBINTERVAL.
C
      DNA=DBLE(NA)
      DT1=DINT(T(1))
      TEMP=DNA*T(1)
      L=IDINT(TEMP-DT1)+1

C         TC IS THE NORMALIZED CHEBYSHEV TIME (-1 .LE. TC .LE. 1)

      TC=2.D0*(DMOD(TEMP,1.D0)+DT1)-1.D0

C       CHECK TO SEE WHETHER CHEBYSHEV TIME HAS CHANGED,
C       AND COMPUTE NEW POLYNOMIAL VALUES IF IT HAS.
C       (THE ELEMENT PC(2) IS THE VALUE OF T1(TC) AND HENCE
C       CONTAINS THE VALUE OF TC ON THE PREVIOUS CALL.)

      IF(TC.NE.PC(2)) THEN
        NP=2
        NV=3
        PC(2)=TC
        TWOT=TC+TC
      ENDIF
C
C       BE SURE THAT AT LEAST 'NCF' POLYNOMIALS HAVE BEEN EVALUATED
C       AND ARE STORED IN THE ARRAY 'PC'.
C
      IF(NP.LT.NCF) THEN
        DO 1 I=NP+1,NCF
        PC(I)=TWOT*PC(I-1)-PC(I-2)
    1   CONTINUE
        NP=NCF
      ENDIF
C
C       INTERPOLATE TO GET POSITION FOR EACH COMPONENT
C
      DO 2 I=1,NCM
      PV(I,1)=0.D0
      DO 3 J=NCF,1,-1
      PV(I,1)=PV(I,1)+PC(J)*BUF(J,I,L)
    3 CONTINUE
    2 CONTINUE
      IF(IFL.LE.1) RETURN
C
C       IF VELOCITY INTERPOLATION IS WANTED, BE SURE ENOUGH
C       DERIVATIVE POLYNOMIALS HAVE BEEN GENERATED AND STORED.
C
      VFAC=(DNA+DNA)/T(2)
      VC(3)=TWOT+TWOT
      IF(NV.LT.NCF) THEN
        DO 4 I=NV+1,NCF
        VC(I)=TWOT*VC(I-1)+PC(I-1)+PC(I-1)-VC(I-2)
    4   CONTINUE
        NV=NCF
      ENDIF
C
C       INTERPOLATE TO GET VELOCITY FOR EACH COMPONENT
C
      DO 5 I=1,NCM
      PV(I,2)=0.D0
      DO 6 J=NCF,2,-1
      PV(I,2)=PV(I,2)+VC(J)*BUF(J,I,L)
    6 CONTINUE
      PV(I,2)=PV(I,2)*VFAC
    5 CONTINUE
C
      RETURN
C
      END

C+++++++++++++++++++++++++
C

ext: f


text:
! Interfaces used internally (e.g. when setting up the optimization user interface, requiring the simulation interface)
module interface_mod
    implicit none

    private
    public :: sim_template  ! Simulation template
    abstract interface

        subroutine sim_template(error, xvar, f_data, evec)
        use iso_c_binding
            double precision, intent(out)               :: error                        ! Error from simulation
            double precision, intent(in)                :: xvar(:)                      ! Variables to be simulated
            type(c_ptr)                                 :: f_data                       ! Data to be used in simulation
            double precision, intent(out), allocatable, optional     :: evec(:)         ! If requested, supplies vector with errors e_i
        end subroutine

    end interface

    contains

end module interface_mod

max_stars_repo_name: KnutAM/matmodfit

max_issues_repo_name: KnutAM/matmodfit

max_forks_repo_name: KnutAM/matmodfit


! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
! Utility Data Module File
!
! Generated by KPP-2.1 symbolic chemistry Kinetics PreProcessor
!       (http://www.cs.vt.edu/~asandu/Software/KPP)
! KPP is distributed under GPL, the general public licence
!       (http://www.gnu.org/copyleft/gpl.html)
! (C) 1995-1997, V. Damian & A. Sandu, CGRER, Univ. Iowa
! (C) 1997-2005, A. Sandu, Michigan Tech, Virginia Tech
!     With important contributions from:
!        M. Damian, Villanova University, USA
!        R. Sander, Max-Planck Institute for Chemistry, Mainz, Germany
!
! File                 : racm_esrlsorg_aqchem_Monitor.f90
! Time                 : Mon Feb 27 11:08:47 2017
! Working directory    : /data/ksetigui/setigui/WRFV3_171015/chem/KPP/mechanisms/racm_esrlsorg_aqchem
! Equation file        : racm_esrlsorg_aqchem.kpp
! Output root filename : racm_esrlsorg_aqchem
!
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

MODULE racm_esrlsorg_aqchem_Monitor

  CHARACTER(LEN=12), PARAMETER, DIMENSION(82) :: SPC_NAMES = (/ &
     'SULF        ','CO2         ','ORA1        ', &
     'ORA2        ','SO2         ','O1D         ', &
     'ISHP        ','HC5         ','TOL         ', &
     'XYL         ','N2O5        ','HC8         ', &
     'MAHP        ','HC3         ','CH4         ', &
     'UDD         ','ETH         ','NALD        ', &
     'HNO4        ','OP1         ','MPAN        ', &
     'HACE        ','HONO        ','H2O2        ', &
     'HKET        ','O3P         ','PHO         ', &
     'ADDT        ','ADDX        ','ETE         ', &
     'ADDC        ','HNO3        ','PAA         ', &
     'ISON        ','PAN         ','API         ', &
     'CO          ','LIM         ','ISO         ', &
     'CSL         ','DIEN        ','MACP        ', &
     'TPAN        ','GLY         ','ETEP        ', &
     'OLTP        ','OLIP        ','MACR        ', &
     'KET         ','ISOP        ','MGLY        ', &
     'CSLP        ','HC8P        ','LIMP        ', &
     'HC5P        ','HCHO        ','TOLP        ', &
     'XYLP        ','APIP        ','ONIT        ', &
     'DCB         ','XO2         ','OLT         ', &
     'ALD         ','OLI         ','OLNN        ', &
     'OLND        ','ETHP        ','KETP        ', &
     'OP2         ','HC3P        ','ACO3        ', &
     'HO          ','NO3         ','HO2         ', &
     'MO2         ','O3          ','TCO3        ', &
     'NO          ','NO2         ','H2O         ', &
     'M           ' /)

  INTEGER, DIMENSION(1) :: LOOKAT
  INTEGER, DIMENSION(1) :: MONITOR
  CHARACTER(LEN=12), DIMENSION(1) :: SMASS
  CHARACTER(LEN=100), PARAMETER, DIMENSION(30) :: EQN_NAMES_0 = (/ &
     '        NO2 --> O3P + NO                                                                            ', &
     '         O3 --> O1D                                                                                ', &
     '         O3 --> O3P                                                                                ', &
     '       HONO --> HO + NO                                                                             ', &
     '       HNO3 --> HO + NO2                                                                            ', &
     '       HNO4 --> 0.35 HO + 0.35 NO3 + 0.65 HO2 + 0.65 NO2                                            ', &
     '        NO3 --> NO                                                                                ', &
     '        NO3 --> O3P + NO2                                                                           ', &
     '       H2O2 --> 2 HO                                                                                ', &
     '       HCHO --> CO                                                                                ', &
     '       HCHO --> CO + 2 HO2                                                                          ', &
     '        ALD --> CO + HO2 + MO2                                                                      ', &
     '        OP1 --> HCHO + HO + HO2                                                                     ', &
     '        OP2 --> ALD + HO + HO2                                                                      ', &
     '        PAA --> HO + MO2                                                                            ', &
     '        KET --> ETHP + ACO3                                                                         ', &
     '        GLY --> 1.87 CO + 0.13 HCHO                                                                 ', &
     '        GLY --> 1.55 CO + 0.45 HCHO + 0.8 HO2                                                       ', &
     '       MGLY --> CO + ACO3 + HO2                                                                     ', &
     '        DCB --> HO2 + TCO3                                                                          ', &
     '       ONIT --> 0.8 KET + 0.2 ALD + HO2 + NO2                                                       ', &
     '       MACR --> CO + HCHO + ACO3 + HO2                                                              ', &
     '       HKET --> HCHO + ACO3 + HO2                                                                   ', &
     '    O3P + M --> O3                                                                                ', &
     '   O3P + O3 --> M                                                                                ', &
     '    O1D + M --> O3P                                                                                ', &
     '  O1D + H2O --> 2 HO                                                                                ', &
     '    HO + O3 --> HO2                                                                                ', &
     '   HO2 + O3 --> HO                                                                                ', &
     '   HO + HO2 --> H2O                                                                                ' /)
  CHARACTER(LEN=100), PARAMETER, DIMENSION(30) :: EQN_NAMES_1 = (/ &
     '  H2O2 + HO --> HO2 + H2O                                                                           ', &
     '      2 HO2 --> H2O2                                                                                ', &
     '2 HO2 + H2O --> H2O2 + H2O                                                                          ', &
     '   O3P + NO --> NO2                                                                                ', &
     '  O3P + NO2 --> NO                                                                                ', &
     '  O3P + NO2 --> NO3                                                                                ', &
     '    HO + NO --> HONO                                                                                ', &
     '   HO + NO2 --> HNO3                                                                                ', &
     '   HO + NO3 --> HO2 + NO2                                                                           ', &
     '   HO2 + NO --> HO + NO2                                                                            ', &
     '  HO2 + NO2 --> HNO4                                                                                ', &
     '       HNO4 --> HO2 + NO2                                                                           ', &
     '  NO3 + HO2 --> 0.3 HNO3 + 0.7 HO + 0.7 NO2                                                         ', &
     '  HONO + HO --> NO2 + H2O                                                                           ', &
     '  HNO3 + HO --> NO3 + H2O                                                                           ', &
     '  HNO4 + HO --> NO2 + H2O                                                                           ', &
     '    O3 + NO --> NO2                                                                                ', &
     '   O3 + NO2 --> NO3                                                                                ', &
     '   2 NO + M --> 2 NO2                                                                               ', &
     '   NO3 + NO --> 2 NO2                                                                               ', &
     '  NO3 + NO2 --> NO + NO2                                                                            ', &
     '  NO3 + NO2 --> N2O5                                                                                ', &
     '       N2O5 --> NO3 + NO2                                                                           ', &
     '      2 NO3 --> 2 NO2                                                                               ', &
     '     HO + M --> HO2 + H2O                                                                           ', &
     '   SO2 + HO --> SULF + HO2                                                                          ', &
     '    CO + HO --> CO2 + HO2                                                                           ', &
     '  NALD + HO --> CO + HCHO + NO2                                                                     ', &
     '  HACE + HO --> MGLY + HO2                                                                          ', &
     '   CH4 + HO --> MO2 + H2O                                                                           ' /)
  CHARACTER(LEN=100), PARAMETER, DIMENSION(30) :: EQN_NAMES_2 = (/ &
     '   ETH + HO --> ETHP + H2O                                                                          ', &
     '   HC3 + HO --> 0.036 ORA1 + 0.036 CO + 0.036 GLY + 0.01 HCHO + 0.335 ALD + 0.583 HC3P + 0.036 HO + ', &
     '   HC5 + HO --> 0.25 KET + 0.75 HC5P + 0.25 HO2 + H2O                                               ', &
     '   HC8 + HO --> 0.024 HKET + 0.9511 HC8P + 0.025 ALD + 0.049 HO2 + H2O                              ', &
     '   ETE + HO --> ETEP                                                                                ', &
     '   OLT + HO --> OLTP                                                                                ', &
     '   OLI + HO --> OLIP                                                                                ', &
     '  DIEN + HO --> ISOP                                                                                ', &
     '   ISO + HO --> ISOP                                                                                ', &
     '   API + HO --> APIP                                                                                ', &
     '   LIM + HO --> LIMP                                                                                ', &
     '   TOL + HO --> 0.9 ADDT + 0.1 XO2 + 0.1 HO2                                                        ', &
     '   XYL + HO --> 0.9 ADDX + 0.1 XO2 + 0.1 HO2                                                        ', &
     '   CSL + HO --> 0.1 PHO + 0.85 ADDC + 0.05 XO2 + 0.05 HO2                                           ', &
     '  HCHO + HO --> CO + HO2 + H2O                                                                      ', &
     '   ALD + HO --> ACO3 + H2O                                                                          ', &
     '   KET + HO --> KETP + H2O                                                                          ', &
     '  HKET + HO --> MGLY + HO2 + H2O                                                                    ', &
     '   GLY + HO --> 2 CO + HO2 + H2O                                                                    ', &
     '  MGLY + HO --> CO + ACO3 + H2O                                                                     ', &
     '  MACR + HO --> MACP                                                                                ', &
     '   DCB + HO --> 0.35 UDD + 0.15 GLY + 0.15 MGLY + 0.5 XO2 + 0.5 HO2 + 0.5 TCO3                      ', &
     '   UDD + HO --> 0.12 KET + 0.88 ALD + HO2                                                           ', &
     '   OP1 + HO --> 0.35 HCHO + 0.35 HO + 0.65 MO2                                                      ', &
     '   OP2 + HO --> 0.41 KET + 0.07 XO2 + 0.08 ALD + 0.44 HC3P + 0.49 HO                                ', &
     '   PAA + HO --> 0.35 HCHO + 0.35 XO2 + 0.65 ACO3 + 0.35 HO2                                         ', &
     '   PAN + HO --> HCHO + XO2 + NO3 + H2O                                                              ', &
     '  TPAN + HO --> 0.6 HKET + 0.4 PAN + 0.4 HCHO + XO2 + 0.6 NO3 + 0.4 HO2                             ', &
     '  ONIT + HO --> HC3P + NO2 + H2O                                                                    ', &
     ' HCHO + NO3 --> HNO3 + CO + HO2                                                                     ' /)
  CHARACTER(LEN=100), PARAMETER, DIMENSION(30) :: EQN_NAMES_3 = (/ &
     '  ALD + NO3 --> HNO3 + ACO3                                                                         ', &
     '  GLY + NO3 --> HNO3 + 2 CO + HO2                                                                   ', &
     ' MGLY + NO3 --> HNO3 + CO + ACO3                                                                    ', &
     '  MAHP + HO --> MACP                                                                                ', &
     '  DCB + NO3 --> 0.5 HNO3 + 0.25 GLY + 0.03 KET + 0.25 MGLY + 0.5 XO2 + 0.25 ALD + 0.5 HO2 + 0.5 TCO3', &
     '  CSL + NO3 --> PHO + HNO3                                                                          ', &
     '  ETE + NO3 --> 0.8 OLNN + 0.2 OLND                                                                 ', &
     '  OLT + NO3 --> 0.43 OLNN + 0.57 OLND                                                               ', &
     '  OLI + NO3 --> 0.11 OLNN + 0.89 OLND                                                               ', &
     ' DIEN + NO3 --> 0.9 MACR + 0.9 OLNN + 0.1 OLND                                                      ', &
     '  ISO + NO3 --> ISON                                                                                ', &
     '  API + NO3 --> 0.1 OLNN + 0.9 OLND                                                                 ', &
     '  LIM + NO3 --> 0.13 OLNN + 0.87 OLND                                                               ', &
     ' TPAN + NO3 --> 0.4 PAN + 0.4 HCHO + 0.6 ONIT + XO2 + 0.6 NO3 + 0.4 NO2                             ', &
     '   ETE + O3 --> 0.37 ORA1 + 0.43 CO + HCHO + 0.12 HO + 0.26 HO2                                     ', &
     '   OLT + O3 --> 0.14 ORA1 + 0.1 ORA2 + 0.06 CH4 + 0.03 ETH + 0.006 H2O2 + 0.37 CO + 0.03 KET + 0.64 ', &
     '   OLI + O3 --> 0.14 ORA2 + 0.07 CH4 + 0.06 ETH + 0.011 H2O2 + 0.3 CO + 0.16 KET + 0.02 HCHO + 0.99 ', &
     '  DIEN + O3 --> 0.15 ORA1 + 0.001 H2O2 + 0.09 O3P + 0.36 CO + 0.39 MACR + 0.9 HCHO + 0.13 XO2 + 0.35', &
     '   ISO + O3 --> 0.28 ORA1 + 0.09 H2O2 + 0.14 CO + 0.1 MACP + 0.65 MACR + 0.58 HCHO + 0.1 ACO3 + 0.25', &
     '   API + O3 --> 0.02 H2O2 + 0.14 CO + 0.53 KET + 0.65 ALD + 0.2 ETHP + 0.42 KETP + 0.85 HO + 0.1 HO2', &
     '   LIM + O3 --> 0.01 ORA1 + 0.07 ORA2 + 0.02 H2O2 + 0.14 CO + 0.79 MACR + 0.04 HCHO + 0.46 OLT + 0.1', &
     '  MACR + O3 --> 0.45 ORA1 + 0.22 CO + 0.9 MGLY + 0.1 ACO3 + 0.19 HO + 0.32 HO2                      ', &
     '   DCB + O3 --> 0.11 ORA1 + 0.21 ORA2 + 0.11 PAA + 0.66 CO + 0.5 GLY + 0.62 MGLY + 0.16 ALD + 0.28 A', &
     '  TPAN + O3 --> 0.11 ORA1 + 0.3 PAN + 0.13 CO + 0.7 HCHO + 0.7 ACO3 + 0.036 HO + 0.08 HO2 + 0.7 NO2 ', &
     '  PHO + NO2 --> 0.1 CSL + ONIT                                                                      ', &
     '  PHO + HO2 --> CSL                                                                                ', &
     ' ADDT + NO2 --> HONO + CSL                                                                          ', &
     '   ADDT + M --> 0.02 CSL + 0.98 TOLP + 0.02 HO2                                                     ', &
     '  ADDT + O3 --> CSL + HO                                                                            ', &
     ' ADDX + NO2 --> HONO + CSL                                                                          ' /)
  CHARACTER(LEN=100), PARAMETER, DIMENSION(30) :: EQN_NAMES_4 = (/ &
     '   ADDX + M --> 0.02 CSL + 0.98 XYLP + 0.02 HO2                                                     ', &
     '  ADDX + O3 --> CSL + HO                                                                            ', &
     ' ADDC + NO2 --> HONO + CSL                                                                          ', &
     '   ADDC + M --> 0.02 CSL + 0.98 CSLP + 0.02 HO2                                                     ', &
     '  ADDC + O3 --> CSL + HO                                                                            ', &
     ' ACO3 + NO2 --> PAN                                                                                ', &
     '        PAN --> ACO3 + NO2                                                                          ', &
     ' TCO3 + NO2 --> TPAN                                                                                ', &
     '       TPAN --> TCO3 + NO2                                                                          ', &
     '   MO2 + NO --> HCHO + HO2 + NO2                                                                    ', &
     '  ETHP + NO --> ALD + HO2 + NO2                                                                     ', &
     '  HC3P + NO --> 0.063 GLY + 0.623 KET + 0.047 HCHO + 0.059 ONIT + 0.048 XO2 + 0.233 ALD + 0.048 ETHP', &
     '  HC5P + NO --> 0.722 KET + 0.021 HCHO + 0.124 ONIT + 0.334 XO2 + 0.211 ALD + 0.245 ETHP + 0.599 HO2', &
     '  HC8P + NO --> 0.642 KET + 0.261 ONIT + 0.416 XO2 + 0.15 ALD + 0.133 ETHP + 0.606 HO2 + 0.739 NO2  ', &
     '  ETEP + NO --> 1.6 HCHO + 0.2 ALD + HO2 + NO2                                                      ', &
     '  OLTP + NO --> 0.06 KET + HCHO + 0.94 ALD + HO2 + NO2                                              ', &
     '  OLIP + NO --> 0.29 KET + 1.71 ALD + HO2 + NO2                                                     ', &
     '  ISOP + NO --> 0.046 ISON + MACR + HCHO + HO2 + NO2                                                ', &
     '  APIP + NO --> 0.8 KET + 0.2 ONIT + 0.8 ALD + 0.8 HO2 + 0.8 NO2                                    ', &
     '  LIMP + NO --> 0.4 MACR + 0.25 HCHO + 0.35 ONIT + 0.25 OLI + 0.65 HO2 + 0.65 NO2                   ', &
     '  TOLP + NO --> 1.2 GLY + 0.65 MGLY + 0.05 ONIT + 0.5 DCB + 0.95 HO2 + 0.95 NO2                     ', &
     '  XYLP + NO --> 0.35 GLY + 0.6 MGLY + 0.05 ONIT + 0.95 DCB + 0.95 HO2 + 0.95 NO2                    ', &
     '  CSLP + NO --> GLY + MGLY + HO2 + NO2                                                              ', &
     '  ACO3 + NO --> MO2 + NO2                                                                           ', &
     '  TCO3 + NO --> HCHO + ACO3 + NO2                                                                   ', &
     '  KETP + NO --> 0.54 MGLY + 0.16 XO2 + 0.46 ALD + 0.23 ACO3 + 0.77 HO2 + NO2                        ', &
     '  OLNN + NO --> ONIT + HO2 + NO2                                                                    ', &
     '  OLND + NO --> 0.464 KET + 0.287 HCHO + 1.24 ALD + 2 NO2                                           ', &
     '  HO2 + MO2 --> OP1                                                                                ', &
     ' ETHP + HO2 --> OP2                                                                                ' /)
  CHARACTER(LEN=100), PARAMETER, DIMENSION(30) :: EQN_NAMES_5 = (/ &
     ' HC3P + HO2 --> OP2                                                                                ', &
     ' HC5P + HO2 --> OP2                                                                                ', &
     ' HC8P + HO2 --> OP2                                                                                ', &
     ' ETEP + HO2 --> OP2                                                                                ', &
     ' OLTP + HO2 --> OP2                                                                                ', &
     ' OLIP + HO2 --> OP2                                                                                ', &
     ' ISOP + HO2 --> ISHP                                                                                ', &
     ' APIP + HO2 --> OP2                                                                                ', &
     ' LIMP + HO2 --> OP2                                                                                ', &
     ' TOLP + HO2 --> OP2                                                                                ', &
     ' XYLP + HO2 --> OP2                                                                                ', &
     ' CSLP + HO2 --> OP2                                                                                ', &
     ' ACO3 + HO2 --> PAA                                                                                ', &
     ' ACO3 + HO2 --> ORA2 + O3                                                                           ', &
     ' HO2 + TCO3 --> OP2                                                                                ', &
     ' HO2 + TCO3 --> ORA2 + O3                                                                           ', &
     ' KETP + HO2 --> OP2                                                                                ', &
     ' OLNN + HO2 --> ONIT                                                                                ', &
     ' OLND + HO2 --> ONIT                                                                                ', &
     '      2 MO2 --> 1.33 HCHO + 0.66 HO2                                                                ', &
     ' ETHP + MO2 --> 0.75 HCHO + 0.75 ALD + HO2                                                          ', &
     ' HC3P + MO2 --> 0.119 GLY + 0.018 KET + 0.005 MGLY + 0.81 HCHO + 0.085 XO2 + 0.58 ALD + 0.992 HO2 + ', &
     ' HC5P + MO2 --> 0.24 KET + 0.829 HCHO + 0.245 XO2 + 0.523 ALD + 0.014 ETHP + 0.946 HO2 + 0.049 MO2  ', &
     ' HC8P + MO2 --> 0.419 KET + 0.753 HCHO + 0.322 XO2 + 0.411 ALD + 0.013 ETHP + 0.993 HO2             ', &
     ' ETEP + MO2 --> 1.55 HCHO + 0.35 ALD + HO2                                                          ', &
     ' OLTP + MO2 --> 0.081 KET + 1.25 HCHO + 0.669 ALD + HO2                                             ', &
     ' OLIP + MO2 --> 0.313 KET + 0.755 HCHO + 0.932 ALD + HO2                                            ', &
     ' ISOP + MO2 --> 0.55 MACR + 1.09 HCHO + 0.37 OLT + 0.08 OLI + HO2                                   ', &
     ' APIP + MO2 --> KET + HCHO + ALD + 2 HO2                                                            ', &
     ' LIMP + MO2 --> 0.6 MACR + 1.4 HCHO + 0.4 OLI + 2 HO2                                               ' /)
  CHARACTER(LEN=100), PARAMETER, DIMENSION(30) :: EQN_NAMES_6 = (/ &
     ' TOLP + MO2 --> 0.65 GLY + 0.35 MGLY + HCHO + DCB + HO2                                             ', &
     ' XYLP + MO2 --> 0.37 GLY + 0.63 MGLY + HCHO + DCB + HO2                                             ', &
     ' CSLP + MO2 --> GLY + MGLY + HCHO + 2 HO2                                                           ', &
     ' ACO3 + MO2 --> HCHO + HO2 + MO2                                                                    ', &
     ' ACO3 + MO2 --> ORA2 + HCHO                                                                         ', &
     ' MO2 + TCO3 --> 2 HCHO + ACO3 + HO2                                                                 ', &
     ' MO2 + TCO3 --> ORA2 + HCHO                                                                         ', &
     ' KETP + MO2 --> 0.3 HKET + 0.4 MGLY + 0.75 HCHO + 0.08 XO2 + 0.3 ALD + 0.12 ACO3 + 0.88 HO2         ', &
     ' OLNN + MO2 --> 0.75 HCHO + ONIT + HO2                                                              ', &
     ' OLND + MO2 --> 0.149 KET + 0.96 HCHO + 0.5 ONIT + 0.64 ALD + 0.5 HO2 + 0.5 NO2                     ', &
     'ETHP + ACO3 --> 0.5 ORA2 + ALD + 0.5 HO2 + 0.5 MO2                                                  ', &
     'HC3P + ACO3 --> 0.499 ORA2 + 0.1 GLY + 0.127 KET + 0.004 MGLY + 0.091 HCHO + 0.071 XO2 + 0.724 ALD +', &
     'HC5P + ACO3 --> 0.495 ORA2 + 0.33 KET + 0.076 HCHO + 0.237 XO2 + 0.677 ALD + 0.018 ETHP + 0.438 HO2 ', &
     'HC8P + ACO3 --> 0.495 ORA2 + 0.581 KET + 0.318 XO2 + 0.497 ALD + 0.015 ETHP + 0.489 HO2 + 0.507 MO2 ', &
     'ETEP + ACO3 --> 0.5 ORA2 + 0.8 HCHO + 0.6 ALD + 0.5 HO2 + 0.5 MO2                                   ', &
     'OLTP + ACO3 --> 0.499 ORA2 + 0.141 KET + 0.501 HCHO + 0.859 ALD + 0.501 HO2 + 0.501 MO2             ', &
     'OLIP + ACO3 --> 0.49 ORA2 + 0.569 KET + 0.941 ALD + 0.51 HO2 + 0.51 MO2                             ', &
     'ISOP + ACO3 --> 0.494 ORA2 + 0.771 MACR + 0.34 HCHO + 0.229 OLT + 0.506 HO2 + 0.506 MO2             ', &
     'APIP + ACO3 --> KET + ALD + HO2 + MO2                                                               ', &
     'LIMP + ACO3 --> 0.6 MACR + 0.4 HCHO + 0.4 OLI + HO2 + MO2                                           ', &
     'TOLP + ACO3 --> 0.65 GLY + 0.35 MGLY + DCB + HO2 + MO2                                              ', &
     'XYLP + ACO3 --> 0.37 GLY + 0.63 MGLY + DCB + HO2 + MO2                                              ', &
     'CSLP + ACO3 --> GLY + MGLY + HO2 + MO2                                                              ', &
     '     2 ACO3 --> 2 MO2                                                                               ', &
     'ACO3 + TCO3 --> HCHO + ACO3 + MO2                                                                   ', &
     'KETP + ACO3 --> 0.5 ORA2 + 0.11 KET + 0.54 MGLY + 0.08 XO2 + 0.35 ALD + 0.12 ACO3 + 0.38 HO2 + 0.5 M', &
     'OLNN + ACO3 --> 0.5 ORA2 + ONIT + 0.5 HO2 + 0.5 MO2                                                 ', &
     'OLND + ACO3 --> 0.484 ORA2 + 0.167 KET + 0.207 HCHO + 0.484 ONIT + 0.65 ALD + 0.516 MO2 + 0.516 NO2 ', &
     '     2 OLNN --> 2 ONIT + HO2                                                                        ', &
     'OLNN + OLND --> 0.149 KET + 0.202 HCHO + 1.5 ONIT + 0.64 ALD + 0.5 HO2 + 0.5 NO2                    ' /)
  CHARACTER(LEN=100), PARAMETER, DIMENSION(30) :: EQN_NAMES_7 = (/ &
     '     2 OLND --> 0.285 KET + 0.504 HCHO + ONIT + 1.21 ALD + NO2                                      ', &
     '  NO3 + MO2 --> HCHO + HO2 + NO2                                                                    ', &
     ' ETHP + NO3 --> ALD + HO2 + NO2                                                                     ', &
     ' HC3P + NO3 --> 0.063 GLY + 0.67 KET + 0.048 HCHO + 0.051 XO2 + 0.243 ALD + 0.053 ETHP + 0.792 HO2 +', &
     ' HC5P + NO3 --> 0.828 KET + 0.021 HCHO + 0.391 XO2 + 0.239 ALD + 0.262 ETHP + 0.699 HO2 + 0.04 MO2 +', &
     ' HC8P + NO3 --> 0.88 KET + 0.587 XO2 + 0.187 ALD + 0.155 ETHP + 0.845 HO2 + NO2                     ', &
     ' ETEP + NO3 --> 1.6 HCHO + 0.2 ALD + HO2 + NO2                                                      ', &
     ' OLTP + NO3 --> 0.06 KET + HCHO + 0.94 ALD + HO2 + NO2                                              ', &
     ' OLIP + NO3 --> 0.29 KET + 1.71 ALD + HO2 + NO2                                                     ', &
     '  MPAN + HO --> HACE + NO2                                                                          ', &
     ' APIP + NO3 --> KET + ALD + HO2 + NO2                                                               ', &
     ' LIMP + NO3 --> 0.6 MACR + 0.4 HCHO + 0.4 OLI + HO2 + NO2                                           ', &
     ' TOLP + NO3 --> 1.3 GLY + 0.7 MGLY + 0.5 DCB + HO2 + NO2                                            ', &
     ' XYLP + NO3 --> 0.74 GLY + 1.26 MGLY + DCB + HO2 + NO2                                              ', &
     ' CSLP + NO3 --> GLY + MGLY + HO2 + NO2                                                              ', &
     ' ACO3 + NO3 --> MO2 + NO2                                                                           ', &
     ' NO3 + TCO3 --> HCHO + ACO3 + NO2                                                                   ', &
     ' KETP + NO3 --> 0.54 MGLY + 0.16 XO2 + 0.46 ALD + 0.23 ACO3 + 0.77 HO2 + NO2                        ', &
     ' OLNN + NO3 --> ONIT + HO2 + NO2                                                                    ', &
     ' OLND + NO3 --> 0.469 KET + 0.28 HCHO + 1.24 ALD + 2 NO2                                            ', &
     '  XO2 + HO2 --> OP2                                                                                ', &
     '  XO2 + MO2 --> HCHO + HO2                                                                          ', &
     ' XO2 + ACO3 --> MO2                                                                                ', &
     '      2 XO2 --> M                                                                                ', &
     '   XO2 + NO --> NO2                                                                                ', &
     '  XO2 + NO3 --> NO2                                                                                ', &
     '     2 ISOP --> 2 MACR + HCHO + HO2                                                                 ', &
     '  ISHP + HO --> MACR + HO                                                                           ', &
     '  ISON + HO --> NALD + HACE                                                                         ', &
     '  MACP + NO --> 0.25 HACE + 0.25 CO + 0.5 MGLY + 0.75 HCHO + 0.25 ACO3 + 0.75 HO2 + NO2             ' /)
  CHARACTER(LEN=100), PARAMETER, DIMENSION(4) :: EQN_NAMES_8 = (/ &
     ' MACP + HO2 --> MAHP                                                                                ', &
     '     2 MACP --> HACE + 0.5 CO + MGLY + 0.5 HCHO + HO2                                               ', &
     ' MACP + NO2 --> MPAN                                                                                ', &
     '       MPAN --> MACP + NO2                                                                          ' /)
  CHARACTER(LEN=100), PARAMETER, DIMENSION(244) :: EQN_NAMES = (/&
    EQN_NAMES_0, EQN_NAMES_1, EQN_NAMES_2, EQN_NAMES_3, EQN_NAMES_4, &
    EQN_NAMES_5, EQN_NAMES_6, EQN_NAMES_7, EQN_NAMES_8 /)

! INLINED global variables

! End INLINED global variables

END MODULE racm_esrlsorg_aqchem_Monitor


text:
! DART software - Copyright UCAR. This open source software is provided
! by UCAR, "as is", without charge, subject to all terms of use at
! http://www.image.ucar.edu/DAReS/DART/DART_download
!
! $Id$

program test_state_structure

use           types_mod, only : r8, i8, i4, MISSING_R8

use       utilities_mod, only : register_module, initialize_utilities, &
                                finalize_utilities, error_handler, &
                                E_ERR, E_MSG

use        obs_kind_mod, only : get_name_for_quantity,  &
                                QTY_U_WIND_COMPONENT,   &
                                QTY_V_WIND_COMPONENT,   &
                                QTY_SURFACE_PRESSURE,   &
                                QTY_STATE_VARIABLE,     &
                                QTY_TEMPERATURE,        &
                                QTY_SALINITY

use          assert_mod, only : assert_equal

use state_structure_mod, only : add_domain,                 &
                                get_domain_size,            &
                                get_num_domains,            &
                                get_variable_size,          &
                                get_variable_name,          &
                                get_num_variables,          &
                                get_num_dims,               &
                                get_dim_lengths,            &
                                get_dim_length,             &
                                add_dimension_to_variable,  &
                                finished_adding_domain,     &
                                state_structure_info,       &
                                get_kind_string,            &
                                get_kind_index,             &
                                get_varid_from_kind,        &
                                get_varids_from_kind,       &
                                get_dim_name,               &
                                get_io_num_dims,            &
                                get_io_dim_ids,             &
                                get_io_dim_lengths,         &
                                get_io_num_unique_dims,     &
                                get_io_unique_dim_name,     &
                                get_io_unique_dim_length,   &
                                add_time_unlimited,         &
                                get_unlimited_dimid,        &
                                set_var_id,                 &
                                get_io_clamping_maxval,     &
                                get_io_clamping_minval,     &
                                do_io_clamping,             &
                                do_io_update,               &
                                get_index_start,            &
                                get_index_end,              &
                                get_sum_variables,          &
                                get_sum_variables_below,    &
                                get_model_variable_indices, &
                                get_dart_vector_index,      &
                                get_num_varids_from_kind

use netcdf

implicit none

! version controlled file description for error handling, do not edit
character(len=256), parameter :: source   = &
   "$URL$"
character(len=32 ), parameter :: revision = "$Revision$"
character(len=128), parameter :: revdate  = "$Date$"

! global variables
integer, parameter :: VAR1 = 1
integer, parameter :: VAR2 = 2
integer, parameter :: VAR3 = 3
integer, parameter :: VAR4 = 4
integer, parameter :: VAR5 = 5 ! variable does not exist

integer, parameter :: DIM1 = 1
integer, parameter :: DIM2 = 2
integer, parameter :: DIM3 = 3
integer, parameter :: DIM4 = 4

integer, parameter :: b1sz = 100
integer, parameter :: b2sz =  10

! number of variables for adding domain from file
integer, parameter :: f1nv = 4
integer, parameter :: f2nv = 3

! number of variables for adding domain from spec
integer, parameter :: spnv = 4

! spec dimension sizes
integer, parameter :: nsd1 = 2
integer, parameter :: nsd2 = 3
integer, parameter :: nsd3 = 4
integer, parameter :: nsd4 = 5

! spec dimension sizes
integer, parameter :: nsdid1 = 1
integer, parameter :: nsdid2 = 2
integer, parameter :: nsdid3 = 3
integer, parameter :: nsdid4 = 4

! spec variable sizes
integer, parameter :: spv1sz = nsd1
integer, parameter :: spv2sz = nsd1*nsd2
integer, parameter :: spv3sz = nsd1*nsd2*nsd3
integer, parameter :: spv4sz = nsd1*nsd2*nsd3*nsd4

! file dimension sizes
integer, parameter :: f1d1 = 3
integer, parameter :: f1d2 = 4
integer, parameter :: f1d3 = 5
integer, parameter :: f1d4 = 1

integer, parameter :: f2d1 = 4
integer, parameter :: f2d2 = 5
integer, parameter :: f2d3 = 6
integer, parameter :: f2d4 = 1

! file dimension ids
integer, parameter :: f1did1 = 1
integer, parameter :: f1did2 = 4
integer, parameter :: f1did3 = 5
integer, parameter :: f1did4 = 7

integer, parameter :: f2did1 = 1
integer, parameter :: f2did2 = 2
integer, parameter :: f2did3 = 3
integer, parameter :: f2did4 = 4

integer, parameter :: f1v1sz = f1d1
integer, parameter :: f1v2sz = f1d1
integer, parameter :: f1v3sz = f1d1
integer, parameter :: f1v4sz = f1d1*f1d2*f1d3

integer, parameter :: f2v1sz = f2d1
integer, parameter :: f2v2sz = f2d1
integer, parameter :: f2v3sz = f2d1*f2d2*f2d3

! domain sizes
integer(i8), parameter :: dsize1 = b1sz
integer(i8), parameter :: dsize2 = b2sz
integer(i8), parameter :: dsize3 = f1v1sz+f1v2sz+f1v3sz+f1v4sz
integer(i8), parameter :: dsize4 = f2v1sz+f2v2sz+f2v3sz
integer(i8), parameter :: dsize5 = spv1sz+spv2sz+spv3sz+spv4sz

! model sizes after adding a domain
integer(i8), parameter :: msize1 = dsize1
integer(i8), parameter :: msize2 = dsize1+dsize2
integer(i8), parameter :: msize3 = dsize1+dsize2+dsize3
integer(i8), parameter :: msize4 = dsize1+dsize2+dsize3+dsize4
integer(i8), parameter :: msize5 = dsize1+dsize2+dsize3+dsize4+dsize5

integer :: did1, did2, did3, did4, did5

integer, parameter :: ndoms = 5

integer(i8), parameter, dimension(ndoms+1) :: msize = (/ 0_i8, msize1, msize2, msize3, msize4, msize5 /)

! simple1.nc metadata
character(len=NF90_MAX_NAME), dimension(f1nv)   ::   var_names1
integer,                      dimension(f1nv)   ::   kind_list1
real(r8),                     dimension(f1nv,2) ::  clamp_vals1
logical,                      dimension(f1nv)   :: update_list1

! simple2.nc metadata
character(len=NF90_MAX_NAME), dimension(f2nv)   ::   var_names2
integer,                      dimension(f2nv)   ::   kind_list2
real(r8),                     dimension(f2nv,2) ::  clamp_vals2
logical,                      dimension(f2nv)   :: update_list2

! domain information for add_domain_from_spec
character(len=NF90_MAX_NAME), dimension(spnv)   ::   var_names3
integer,                      dimension(spnv)   ::   kind_list3
real(r8),                     dimension(spnv,2) ::  clamp_vals3
logical,                      dimension(spnv)   :: update_list3

character(len=32)            :: kindString
character(len=NF90_MAX_NAME) :: varName
integer(i8)                  :: int8Val
integer                      :: intVal
real(r8)                     :: realVal
logical                      :: trueFalse

integer(i8) :: state_indx
integer     :: dom

character(len=512) :: string1

! namelist variables
logical :: debug = .false.

! namelist items we are going to create/overwrite
namelist /test_state_structure_nml/  debug

! main code here

! initialize the dart libs
call initialize_module()

call error_handler(E_ERR,'test_state_structure ',&
                   'Has not been tested yet with new naming conventions.',source,revision,revdate)

call initialize_domains()

did1 = add_domain(int(b1sz,i8))
did2 = add_domain(int(b2sz,i8))
did3 = add_domain('simple1.nc', f1nv,   var_names1, &
                  kind_list1, clamp_vals1, update_list1)
did4 = add_domain('simple2.nc', f2nv,   var_names2, &
                  kind_list2, clamp_vals2, update_list2)
did5 = add_domain(spnv, var_names3, kind_list3, clamp_vals3, update_list3)

! add dimensions for domains from spec
call fill_domain_structure_for_spec(did5)

if ( debug ) then
   write(*,*)
   write(*,*)'=============================================================='
   write(*,*)'State structure information.'
   write(*,*)'=============================================================='
   write(*,*)

   call state_structure_info(did1)
   call state_structure_info(did2)
   call state_structure_info(did3)
   call state_structure_info(did4)
   call state_structure_info(did5)
endif

write(*,*)
write(*,*)'=============================================================='
write(*,*)'Testing domain sizes.'
write(*,*)'=============================================================='
write(*,*)

call assert_equal(get_num_domains(), ndoms, 'get_num_domains')

write(*,*)' ... Testing Domain 1'
call test_sizes_domain(did1, exp_dom_size     = b1sz, &
                             exp_num_dom_vars = 1, & ! only one var for blank
                             exp_unlim_dimid  = -1) ! no unlim dim

write(*,*)' ... Testing Domain 2'
call test_sizes_domain(did2, exp_dom_size     = b2sz, &
                             exp_num_dom_vars = 1, &
                             exp_unlim_dimid  = -1)

write(*,*)' ... Testing Domain 3'
call test_sizes_domain(did3, exp_dom_size     = f1v1sz+f1v2sz+f1v3sz+f1v4sz, &
                             exp_num_dom_vars = 4, &
                             exp_unlim_dimid  = 7)

write(*,*)' ... Testing Domain 4'
call test_sizes_domain(did4, exp_dom_size     = f2v1sz+f2v2sz+f2v3sz, &
                             exp_num_dom_vars = 3, &
                             exp_unlim_dimid  = 4)

write(*,*)' ... Testing Domain 5'
call test_sizes_domain(did5, exp_dom_size     = spv1sz+spv2sz+spv3sz+spv4sz, &
                             exp_num_dom_vars = 4, &
                             exp_unlim_dimid  = -1)

write(*,*)
write(*,*)'=============================================================='
write(*,*)'Testing variable information.'
write(*,*)'=============================================================='
write(*,*)

write(*,*)' ... Testing Domain 1'
call test_variable_info(did1, VAR1, &
                        exp_var_size    = b1sz, &
                        exp_num_dims    = 1, &
                        exp_kind_indx   =  QTY_STATE_VARIABLE, &
                        exp_kind_string = 'QTY_STATE_VARIABLE',&
                        exp_var_name    = 'state')

write(*,*)' ... Testing Domain 2'
call test_variable_info(did2, VAR1, &
                        exp_var_size    = b2sz, &
                        exp_num_dims    = 1, &
                        exp_kind_indx   =  QTY_STATE_VARIABLE, &
                        exp_kind_string = 'QTY_STATE_VARIABLE',&
                        exp_var_name    = 'state')

write(*,*)' ... Testing Domain 3 Var 1'
call test_variable_info(did3, VAR1, &
                        exp_var_size    = f1d1, &
                        exp_num_dims    = 1, &
                        exp_kind_indx   =  QTY_STATE_VARIABLE, &
                        exp_kind_string = 'QTY_STATE_VARIABLE',&
                        exp_var_name    = 'A')

write(*,*)' ... Testing Domain 3 Var 4'
call test_variable_info(did3, VAR4, &
                        exp_var_size    = f1d1*f1d2*f1d3, &
                        exp_num_dims    = 3, &
                        exp_kind_indx   =  QTY_TEMPERATURE, &
                        exp_kind_string = 'QTY_TEMPERATURE',&
                        exp_var_name    = 'temp')

write(*,*)' ... Testing Domain 4 Var 1'
call test_variable_info(did4, VAR1, &
                        exp_var_size    = f2d1, &
                        exp_num_dims    = 1, &
                        exp_kind_indx   =  QTY_STATE_VARIABLE, &
                        exp_kind_string = 'QTY_STATE_VARIABLE',&
                        exp_var_name    = 'B')

call test_variable_info(did4, VAR3, &
                        exp_var_size    = f2d1*f2d2*f2d3, &
                        exp_num_dims    = 3, &
                        exp_kind_indx   =  QTY_TEMPERATURE, &
                        exp_kind_string = 'QTY_TEMPERATURE',&
                        exp_var_name    = 'temp')

write(*,*)' ... Testing Domain 5 Var 1'
call test_variable_info(did5, VAR1, &
                        exp_var_size    = spv1sz, &
                        exp_num_dims    = 1, &
                        exp_kind_indx   = QTY_SURFACE_PRESSURE, &
                        exp_kind_string = 'QTY_SURFACE_PRESSURE',&
                        exp_var_name    = 'PS')

write(*,*)' ... Testing Domain 5 Var 4'
call test_variable_info(did5, VAR4, &
                        exp_var_size    = spv4sz, &
                        exp_num_dims    = 4, &
                        exp_kind_indx   =  QTY_V_WIND_COMPONENT, &
                        exp_kind_string = 'QTY_V_WIND_COMPONENT',&
                        exp_var_name    = 'V ')

write(*,*)
write(*,*)'=============================================================='
write(*,*)'Testing dimension information.'
write(*,*)'=============================================================='
write(*,*)

write(*,*)' ... Testing Domain 1 Var 1'
call test_dimension_info(did1, VAR1, &
                         dim_ids            = (/DIM1/), &
                         exp_dim_names      = (/'domain_size'/), &
                         exp_dim_lengths    = (/b1sz/), &
                         io_dim_ids         = (/DIM1/), &
                         exp_io_numdims     = 1, &
                         exp_io_dim_names   = (/'domain_size'/), &
                         exp_io_dim_lengths = (/ b1sz/), &
                         exp_io_dim_ids     = (/ 1/), &
                         exp_io_unique_dim_ids = (/1/), &
                         exp_io_unique_numdims = 1, &
                         exp_io_unique_dim_length = (/ b1sz/), &
                         exp_io_unique_dim_names = (/'domain_size'/) )

write(*,*)' ... Testing Domain 2 Var 1'
call test_dimension_info(did2, VAR1, &
                         dim_ids            = (/DIM1/), &
                         exp_dim_names      = (/'domain_size'/), &
                         exp_dim_lengths    = (/b2sz/), &
                         io_dim_ids         = (/DIM1/), &
                         exp_io_numdims     = 1, &
                         exp_io_dim_names   = (/'domain_size'/), &
                         exp_io_dim_lengths = (/ b2sz/), &
                         exp_io_dim_ids     = (/ 1/), &
                         exp_io_unique_dim_ids = (/1/), &
                         exp_io_unique_numdims = 1, &
                         exp_io_unique_dim_length = (/ b2sz/), &
                         exp_io_unique_dim_names = (/'domain_size'/) )

write(*,*)' ... Testing Domain 3 Var 1'
call test_dimension_info(did3, VAR1, &
                         dim_ids            = (/DIM1/), &
                         exp_dim_names      = (/'level'/), &
                         exp_dim_lengths    = (/ f1d1/), &
                         io_dim_ids         = (/DIM1/), &
                         exp_io_numdims     = 1, &
                         exp_io_dim_names   = (/'level', 'lat  ', 'lon  ', 'time '/), &
                         exp_io_dim_lengths = (/ f1d1/), &
                         exp_io_dim_ids     = (/DIM1/), &
                         exp_io_unique_dim_ids = (/DIM1, DIM2, DIM3, DIM4/), &
                         exp_io_unique_numdims = 4, &
                         exp_io_unique_dim_length = (/ f1d1, f1d2, f1d3, f1d4/), &
                         exp_io_unique_dim_names = (/'level', 'lat  ', 'lon  ','time '/) )

write(*,*)' ... Testing Domain 3 Var 4'
call test_dimension_info(did3, VAR4, &
                         dim_ids            = (/DIM1, DIM2, DIM3/), &
                         exp_dim_names      = (/'level', 'lat  ', 'lon  '/), &
                         exp_dim_lengths    = (/ f1d1, f1d2, f1d3/), &
                         io_dim_ids         = (/DIM1, DIM2, DIM3, DIM4/), &
                         exp_io_numdims     = 4, &
                         exp_io_dim_names   = (/'level', 'lat  ', 'lon  ','time '/), &
                         exp_io_dim_lengths = (/ f1d1, f1d2, f1d3, f1d4/), &
                         exp_io_dim_ids     = (/f1did1, f1did2, f1did3, f1did4/), &
                         exp_io_unique_dim_ids = (/DIM1, DIM2, DIM3, DIM4/), &
                         exp_io_unique_numdims = 4, &
                         exp_io_unique_dim_length = (/ f1d1, f1d2, f1d3, f1d4/), &
                         exp_io_unique_dim_names = (/'level', 'lat  ', 'lon  ','time '/) )

write(*,*)' ... Testing Domain 4 Var 2'
call test_dimension_info(did4, VAR2, &
                         dim_ids            = (/DIM1/), &
                         exp_dim_names      = (/'level'/), &
                         exp_dim_lengths    = (/ f2d1/), &
                         io_dim_ids         = (/DIM1/), &
                         exp_io_numdims     = 1, &
                         exp_io_dim_names   = (/'level'/), &
                         exp_io_dim_lengths = (/ f2d1/), &
                         exp_io_dim_ids     = (/ f2did1/), &
                         exp_io_unique_dim_ids = (/DIM1, DIM2, DIM3, DIM4/), &
                         exp_io_unique_numdims = 4, &
                         exp_io_unique_dim_length = (/ f2d1, f2d2, f2d3, f2d4/), &
                         exp_io_unique_dim_names = (/'level', 'lat  ', 'lon  ','time '/) )

write(*,*)' ... Testing Domain 4 Var 3'
call test_dimension_info(did4, VAR3, &
                         dim_ids            = (/DIM1, DIM2, DIM3/), &
                         exp_dim_names      = (/'level', 'lat  ', 'lon  '/), &
                         exp_dim_lengths    = (/ f2d1, f2d2, f2d3/), &
                         io_dim_ids         = (/DIM1, DIM2, DIM3, DIM4/), &
                         exp_io_numdims     = 4, &
                         exp_io_dim_names   = (/'level', 'lat  ', 'lon  ','time '/), &
                         exp_io_dim_lengths = (/ f2d1, f2d2, f2d3, f2d4/), &
                         exp_io_dim_ids     = (/ f2did1, f2did2, f2did3, f2did4/), &
                         exp_io_unique_dim_ids = (/DIM1, DIM2, DIM3, DIM4/), &
                         exp_io_unique_numdims = 4, &
                         exp_io_unique_dim_length = (/ f2d1, f2d2, f2d3, f2d4/), &
                         exp_io_unique_dim_names = (/'level', 'lat  ', 'lon  ','time '/) )

write(*,*)' ... Testing Domain 5 Var 2'
call test_dimension_info(did5, VAR2, &
                         dim_ids            = (/DIM1, DIM2/), &
                         exp_dim_names      = (/'dim1', 'dim2'/), &
                         exp_dim_lengths    = (/ nsd1, nsd2/), &
                         io_dim_ids         = (/DIM1, DIM2/), &
                         exp_io_numdims     = 2, &
                         exp_io_dim_names   = (/'dim1', 'dim2'/), &
                         exp_io_dim_lengths = (/ nsd1, nsd2/), &
                         exp_io_dim_ids     = (/ nsdid1, nsdid2/), &
                         exp_io_unique_dim_ids = (/1,2,3,4,5,6,7,8,9,10/), &
                         exp_io_unique_numdims = 10, &
                         exp_io_unique_dim_length = (/ nsd1, &
                                                       nsd1, nsd2, &
                                                       nsd1, nsd2, nsd3, &
                                                       nsd1, nsd2, nsd3,nsd4/), &
                         exp_io_unique_dim_names = (/'dim1', &
                                                     'dim1', 'dim2', &
                                                     'dim1', 'dim2', 'dim3', &
                                                     'dim1', 'dim2', 'dim3', 'dim4'/) )
write(*,*)' ... Testing Domain 5 Var 4'
call test_dimension_info(did5, VAR4, &
                         dim_ids            = (/DIM1, DIM2, DIM3, DIM4/), &
                         exp_dim_names      = (/'dim1', 'dim2', 'dim3', 'dim4'/), &
                         exp_dim_lengths    = (/ nsd1, nsd2, nsd3, nsd4/), &
                         io_dim_ids         = (/DIM1, DIM2, DIM3, DIM4/), &
                         exp_io_numdims     = 4, &
                         exp_io_dim_names   = (/'dim1', 'dim2', 'dim3', 'dim4'/), &
                         exp_io_dim_lengths = (/ nsd1, nsd2, nsd3, nsd4/), &
                         exp_io_dim_ids     = (/ nsdid1, nsdid2, nsdid3, nsdid4/), &
                         exp_io_unique_dim_ids = (/1,2,3,4,5,6,7,8,9,10/), &
                         exp_io_unique_numdims = 10, &
                         exp_io_unique_dim_length = (/ nsd1, &
                                                       nsd1, nsd2, &
                                                       nsd1, nsd2, nsd3, &
                                                       nsd1, nsd2, nsd3,nsd4/), &
                         exp_io_unique_dim_names = (/'dim1', &
                                                     'dim1', 'dim2', &
                                                     'dim1', 'dim2', 'dim3', &
                                                     'dim1', 'dim2', 'dim3', 'dim4'/) )

write(*,*)
write(*,*)'=============================================================='
write(*,*)'Testing update and clamping.'
write(*,*)'=============================================================='
write(*,*)

write(*,*)' ... Testing Domain 1 Var 1'
call test_update_and_clamping(did1, VAR1, &
                              exp_clamp_min = MISSING_R8, &
                              exp_clamp_max = MISSING_R8, &
                              exp_clamping  = .false., &
                              exp_update    = .true.)

write(*,*)' ... Testing Domain 2 Var 1'
call test_update_and_clamping(did2, VAR1, &
                              exp_clamp_min = MISSING_R8, &
                              exp_clamp_max = MISSING_R8, &
                              exp_clamping  = .false., &
                              exp_update    = .true.)

write(*,*)' ... Testing Domain 3 Var 1'
call test_update_and_clamping(did3, VAR1, &
                              exp_clamp_min = clamp_vals1(VAR1,1), &
                              exp_clamp_max = clamp_vals1(VAR1,2), &
                              exp_clamping  = .true., &
                              exp_update    = update_list1(VAR1))

write(*,*)' ... Testing Domain 3 Var 4'
call test_update_and_clamping(did3, VAR4, &
                              exp_clamp_min = clamp_vals1(VAR4,1), &
                              exp_clamp_max = clamp_vals1(VAR4,2), &
                              exp_clamping  = .true., &
                              exp_update    = update_list1(VAR4))

write(*,*)' ... Testing Domain 4 Var 1'
call test_update_and_clamping(did4, VAR1, &
                              exp_clamp_min = clamp_vals2(VAR1,1), &
                              exp_clamp_max = clamp_vals2(VAR1,2), &
                              exp_clamping  = .false., &
                              exp_update    = update_list1(VAR1))

write(*,*)' ... Testing Domain 4 Var 3'
call test_update_and_clamping(did4, VAR3, &
                              exp_clamp_min = clamp_vals2(VAR3,1), &
                              exp_clamp_max = clamp_vals2(VAR3,2), &
                              exp_clamping  = .true., &
                              exp_update    = update_list1(VAR3))

write(*,*)' ... Testing Domain 5 Var 1'
call test_update_and_clamping(did5, VAR1, &
                              exp_clamp_min = clamp_vals3(VAR1,1), &
                              exp_clamp_max = clamp_vals3(VAR1,2), &
                              exp_clamping  = .false., &
                              exp_update    = update_list3(VAR1))

write(*,*)' ... Testing Domain 5 Var 3'
call test_update_and_clamping(did5, VAR3, &
                              exp_clamp_min = clamp_vals3(VAR3,1), &
                              exp_clamp_max = clamp_vals3(VAR3,2), &
                              exp_clamping  = .true., &
                              exp_update    = update_list3(VAR3))

write(*,*)
write(*,*)'=============================================================='
write(*,*)'Testing start and end indices'
write(*,*)'=============================================================='
write(*,*)

write(*,*)' ... Testing Domain 1 Var 1'
call test_indices(did1, VAR1, &
                  var_name  = 'state', &
                  exp_start = int(1,i8) , &
                  exp_end   = int(b1sz,i8))

write(*,*)' ... Testing Domain 2 Var 1'
call test_indices(did2, VAR1, &
                  var_name  = 'state', &
                  exp_start = msize1+1 , &
                  exp_end   = msize1+b2sz)

write(*,*)' ... Testing Domain 3 Var 1'
call test_indices(did3, VAR1, &
                  var_name  = 'A', &
                  exp_start = msize2+1 , &
                  exp_end   = msize2+f1v1sz )

write(*,*)' ... Testing Domain 3 Var 4'
call test_indices(did3, VAR4, &
                  var_name  = 'temp', &
                  exp_start = msize2+1+f1v1sz+f1v2sz+f1v3sz, &
                  exp_end   = msize2+  f1v1sz+f1v2sz+f1v3sz+f1v4sz )

write(*,*)' ... Testing Domain 4 Var 1'
call test_indices(did4, VAR1, &
                  var_name  = 'B', &
                  exp_start = msize3+1 , &
                  exp_end   = msize3+f2v1sz )

write(*,*)' ... Testing Domain 4 Var 3'
call test_indices(did4, VAR3, &
                  var_name  = 'temp', &
                  exp_start = msize3+1+f2v1sz+f2v2sz, &
                  exp_end   = msize3 + f2v1sz+f2v2sz+f2v3sz )

write(*,*)' ... Testing Domain 5 Var 2'
call test_indices(did5, VAR2, &
                  var_name  = 'T', &
                  exp_start = msize4+1+spv1sz, &
                  exp_end   = msize4 + spv1sz +spv2sz )

write(*,*)' ... Testing Domain 5 Var 4'
call test_indices(did5, VAR4, &
                  var_name  = 'V', &
                  exp_start = msize4+1+spv1sz+spv2sz+spv3sz, &
                  exp_end   = msize4 + spv1sz+spv2sz+spv3sz+spv4sz )

write(*,*)
write(*,*)'=============================================================='
write(*,*)'Testing sum variables below'
write(*,*)'=============================================================='
write(*,*)

write(*,*)' ... Testing Domain 1 Var 1'
call test_sum_variables_below(did1, VAR1, VAR1, &
                              exp_sum_range  = int(b1sz,i8), &
                              exp_sum_below1 = int(0,i8), &
                              exp_sum_below2 = int(0,i8))

write(*,*)' ... Testing Domain 2 Var 1'
call test_sum_variables_below(did2, VAR1, VAR1, &
                              exp_sum_range  = int(b2sz,i8), &
                              exp_sum_below1 = int(b1sz,i8), &
                              exp_sum_below2 = int(b1sz,i8))

write(*,*)' ... Testing Domain 3 Var 2 to Var 3'
call test_sum_variables_below(did3, VAR2, VAR3, &
                              exp_sum_range  = int(f1v2sz+f1v3sz,i8), &
                              exp_sum_below1 = int(msize2+f1v1sz,i8), &
                              exp_sum_below2 = int(msize2+f1v1sz+f1v2sz,i8))

write(*,*)' ... Testing Domain 4 Var 1 to Var 3'
call test_sum_variables_below(did4, VAR1, VAR3, &
                              exp_sum_range  = int(f2v1sz+f2v2sz+f2v3sz,i8), &
                              exp_sum_below1 = int(msize3,i8), &
                              exp_sum_below2 = int(msize3+f2v1sz+f2v2sz,i8))

write(*,*)' ... Testing Domain 5 Var 1 to Var 3'
call test_sum_variables_below(did5, VAR1, VAR3, &
                              exp_sum_range  = int(spv1sz+spv2sz+spv3sz,i8), &
                              exp_sum_below1 = int(msize4,i8), &
                              exp_sum_below2 = int(msize4+spv1sz+spv2sz,i8))

write(*,*)
write(*,*)'=============================================================='
write(*,*)'Testing state indicies'
write(*,*)'=============================================================='
write(*,*)

! DOMAIN1
state_indx = 10_i8
dom = find_domain(state_indx)
write(*,'(A,I5,A,I1)') '  ... Testing state_index ', state_indx, ' Domain ', dom
call test_state_indicies(state_indx, &
                         exp_iloc = 10, &
                         exp_jloc =  1, &
                         exp_kloc =  1, &
                         exp_varid = 1, &
                         exp_domid = dom, &
                         exp_kind_index  =  QTY_STATE_VARIABLE, &
                         exp_kind_string = 'QTY_STATE_VARIABLE')

! DOMAIN2
state_indx = 109_i8
dom = find_domain(state_indx)
write(*,'(A,I5,A,I1)') '  ... Testing state_index ', state_indx, ' Domain ', dom
call test_state_indicies(state_indx, &
                         exp_iloc =  9, &
                         exp_jloc =  1, &
                         exp_kloc =  1, &
                         exp_varid = 1, &
                         exp_domid = dom, &
                         exp_kind_index  =  QTY_STATE_VARIABLE, &
                         exp_kind_string = 'QTY_STATE_VARIABLE')

! DOMAIN3
state_indx = 112_i8
dom = find_domain(state_indx)
write(*,'(A,I5,A,I1)') '  ... Testing state_index ', state_indx, ' Domain ', dom
call test_state_indicies(state_indx, &
                         exp_iloc =  2, &
                         exp_jloc =  1, &
                         exp_kloc =  1, &
                         exp_varid = 1, &
                         exp_domid = dom, &
                         exp_kind_index  =  QTY_STATE_VARIABLE, &
                         exp_kind_string = 'QTY_STATE_VARIABLE')

! DOMAIN3
state_indx = 115_i8
dom = find_domain(state_indx)
write(*,'(A,I5,A,I1)') '  ... Testing state_index ', state_indx, ' Domain ', dom
call test_state_indicies(state_indx, &
                         exp_iloc =  2, &
                         exp_jloc =  1, &
                         exp_kloc =  1, &
                         exp_varid = 2, &
                         exp_domid = dom, &
                         exp_kind_index  =  QTY_STATE_VARIABLE, &
                         exp_kind_string = 'QTY_STATE_VARIABLE')

! DOMAIN3
state_indx = 179_i8
dom = find_domain(state_indx)
write(*,'(A,I5,A,I1)') '  ... Testing state_index ', state_indx, ' Domain ', dom
call test_state_indicies(state_indx, &
                         exp_iloc =  3, &
                         exp_jloc =  4, &
                         exp_kloc =  5, &
                         exp_varid = 4, &
                         exp_domid = dom, &
                         exp_kind_index  =  QTY_TEMPERATURE, &
                         exp_kind_string = 'QTY_TEMPERATURE')

! DOMAIN3
state_indx = 178_i8
dom = find_domain(state_indx)
write(*,'(A,I5,A,I1)') '  ... Testing state_index ', state_indx, ' Domain ', dom
call test_state_indicies(state_indx, &
                         exp_iloc =  2, &
                         exp_jloc =  4, &
                         exp_kloc =  5, &
                         exp_varid = 4, &
                         exp_domid = dom, &
                         exp_kind_index  =  QTY_TEMPERATURE, &
                         exp_kind_string = 'QTY_TEMPERATURE')

! DOMAIN4
state_indx = 179_i8
dom = find_domain(state_indx)
write(*,'(A,I5,A,I1)') '  ... Testing state_index ', state_indx, ' Domain ', dom
call test_state_indicies(state_indx, &
                         exp_iloc =  3, &
                         exp_jloc =  4, &
                         exp_kloc =  5, &
                         exp_varid = 4, &
                         exp_domid = dom, &
                         exp_kind_index  =  QTY_TEMPERATURE, &
                         exp_kind_string = 'QTY_TEMPERATURE')

! DOMAIN4
state_indx = 187_i8
dom = find_domain(state_indx)
write(*,'(A,I5,A,I1)') '  ... Testing state_index ', state_indx, ' Domain ', dom
call test_state_indicies(state_indx, &
                         exp_iloc =  4, &
                         exp_jloc =  1, &
                         exp_kloc =  1, &
                         exp_varid = 2, &
                         exp_domid = dom, &
                         exp_kind_index  =  QTY_SALINITY, &
                         exp_kind_string = 'QTY_SALINITY')

! DOMAIN4
state_indx = 194_i8
dom = find_domain(state_indx)
write(*,'(A,I5,A,I1)') '  ... Testing state_index ', state_indx, ' Domain ', dom
call test_state_indicies(state_indx, &
                         exp_iloc =  3, &
                         exp_jloc =  2, &
                         exp_kloc =  1, &
                         exp_varid = 3, &
                         exp_domid = dom, &
                         exp_kind_index  =  QTY_TEMPERATURE, &
                         exp_kind_string = 'QTY_TEMPERATURE')

! DOMAIN4
state_indx = 307_i8
dom = find_domain(state_indx)
write(*,'(A,I5,A,I1)') '  ... Testing state_index ', state_indx, ' Domain ', dom
call test_state_indicies(state_indx, &
                         exp_iloc =  4, &
                         exp_jloc =  5, &
                         exp_kloc =  6, &
                         exp_varid = 3, &
                         exp_domid = dom, &
                         exp_kind_index  =  QTY_TEMPERATURE, &
                         exp_kind_string = 'QTY_TEMPERATURE')

! DOMAIN5
state_indx = 308_i8
dom = find_domain(state_indx)
write(*,'(A,I5,A,I1)') '  ... Testing state_index ', state_indx, ' Domain ', dom
call test_state_indicies(state_indx, &
                         exp_iloc =  1, &
                         exp_jloc =  1, &
                         exp_kloc =  1, &
                         exp_varid = 1, &
                         exp_domid = dom, &
                         exp_kind_index  =  QTY_SURFACE_PRESSURE, &
                         exp_kind_string = 'QTY_SURFACE_PRESSURE')

! DOMAIN5
state_indx = 318_i8
dom = find_domain(state_indx)
write(*,'(A,I5,A,I1)') '  ... Testing state_index ', state_indx, ' Domain ', dom
call test_state_indicies(state_indx, &
                         exp_iloc =  1, &
                         exp_jloc =  2, &
                         exp_kloc =  1, &
                         exp_varid = 3, &
                         exp_domid = dom, &
                         exp_kind_index  =  QTY_U_WIND_COMPONENT, &
                         exp_kind_string = 'QTY_U_WIND_COMPONENT')

write(*,*)
write(*,*)'=============================================================='
write(*,*)'Testing varids from kind'
write(*,*)'=============================================================='
write(*,*)

write(*,'(2A)')'  ... Testing Domain 1 Kind ', trim(get_name_for_quantity(QTY_STATE_VARIABLE))
call test_varids_from_kind(did1, QTY_STATE_VARIABLE, &
                           exp_num_varids_from_kind = 1, &
                           exp_varids_from_kind = (/1/) )

write(*,'(2A)')'  ... Testing Domain 1 Kind ', trim(get_name_for_quantity(QTY_TEMPERATURE))
call test_varids_from_kind(did1, QTY_TEMPERATURE, &
                           exp_num_varids_from_kind = 0, &
                           exp_varids_from_kind = (/-1/) )

write(*,'(2A)')'  ... Testing Domain 2 Kind ', trim(get_name_for_quantity(QTY_STATE_VARIABLE))
call test_varids_from_kind(did2, QTY_STATE_VARIABLE, &
                           exp_num_varids_from_kind = 1, &
                           exp_varids_from_kind = (/1/) )

write(*,'(2A)')'  ... Testing Domain 2 Kind ', trim(get_name_for_quantity(QTY_TEMPERATURE))
call test_varids_from_kind(did2, QTY_TEMPERATURE, &
                           exp_num_varids_from_kind = 0, &
                           exp_varids_from_kind = (/-1/) )

write(*,'(2A)')'  ... Testing Domain 3 Kind ', trim(get_name_for_quantity(QTY_STATE_VARIABLE))
call test_varids_from_kind(did3, QTY_STATE_VARIABLE, &
                           exp_num_varids_from_kind = 3, &
                           exp_varids_from_kind = (/1, 2, 3/) )

write(*,'(2A)')'  ... Testing Domain 3 Kind ', trim(get_name_for_quantity(QTY_TEMPERATURE))
call test_varids_from_kind(did3, QTY_TEMPERATURE, &
                           exp_num_varids_from_kind = 1, &
                           exp_varids_from_kind = (/4/) )

write(*,'(2A)')'  ... Testing Domain 4 Kind ', trim(get_name_for_quantity(QTY_STATE_VARIABLE))
call test_varids_from_kind(did4, QTY_STATE_VARIABLE, &
                           exp_num_varids_from_kind = 1, &
                           exp_varids_from_kind = (/1/) )

write(*,'(2A)')'  ... Testing Domain 4 Kind ', trim(get_name_for_quantity(QTY_SALINITY))
call test_varids_from_kind(did4, QTY_SALINITY, &
                           exp_num_varids_from_kind = 1, &
                           exp_varids_from_kind = (/2/) )

write(*,'(2A)')'  ... Testing Domain 4 Kind ', trim(get_name_for_quantity(QTY_TEMPERATURE))
call test_varids_from_kind(did4, QTY_TEMPERATURE, &
                           exp_num_varids_from_kind = 1, &
                           exp_varids_from_kind = (/3/) )

write(*,'(2A)')'  ... Testing Domain 5 Kind ', trim(get_name_for_quantity(QTY_SURFACE_PRESSURE))
call test_varids_from_kind(did5, QTY_SURFACE_PRESSURE, &
                           exp_num_varids_from_kind = 1, &
                           exp_varids_from_kind = (/1/) )

write(*,'(2A)')'  ... Testing Domain 5 Kind ', trim(get_name_for_quantity(QTY_TEMPERATURE))
call test_varids_from_kind(did5, QTY_TEMPERATURE, &
                           exp_num_varids_from_kind = 1, &
                           exp_varids_from_kind = (/2/) )

write(*,'(2A)')'  ... Testing Domain 5 Kind ', trim(get_name_for_quantity(QTY_U_WIND_COMPONENT))
call test_varids_from_kind(did5, QTY_U_WIND_COMPONENT, &
                           exp_num_varids_from_kind = 1, &
                           exp_varids_from_kind = (/3/) )

write(*,'(2A)')'  ... Testing Domain 5 Kind ', trim(get_name_for_quantity(QTY_V_WIND_COMPONENT))
call test_varids_from_kind(did5, QTY_V_WIND_COMPONENT, &
                           exp_num_varids_from_kind = 1, &
                           exp_varids_from_kind = (/4/) )

print*, ' '
! finalize test_state_structure
call error_handler(E_MSG,'test_state_structure',&
                   'Finished successfully.',source,revision,revdate)

call finalize_utilities()

! end of main code

contains

!----------------------------------------------------------------------

subroutine initialize_domains()

   !!!! DOMAIN 1 and DOMAIN 2 !!!!

   ! ! info for blank domain
   ! b1sz = 100_i8
   ! b2sz = 10_i8

   !!!! DOMAIN 3 !!!!

   ! info for domain from file1
   var_names1 = (/'A   ', 'B   ', 'C   ', 'temp'/)
   kind_list1 = (/QTY_STATE_VARIABLE, QTY_STATE_VARIABLE,  &
                  QTY_STATE_VARIABLE, QTY_TEMPERATURE/)
   ! variable A
   clamp_vals1(1,1) = 0.0_r8
   clamp_vals1(1,2) = MISSING_R8
   ! variable B
   clamp_vals1(2,1) = MISSING_R8
   clamp_vals1(2,2) = MISSING_R8
   ! variable C
   clamp_vals1(3,1) = MISSING_R8
   clamp_vals1(3,2) = 10.0_r8
   ! variable temp
   clamp_vals1(4,1) =  1.0_r8
   clamp_vals1(4,2) = 20.0_r8

   update_list1 = (/.true., .true., .false., .false./)

   !!!! DOMAIN 4 !!!!

   ! info for domain from file2
   var_names2 = (/'B   ', 'C   ', 'temp'/)
   kind_list2 = (/QTY_STATE_VARIABLE, QTY_SALINITY,  &
                  QTY_TEMPERATURE/)
   ! variable B
   clamp_vals2(1,1) = MISSING_R8
   clamp_vals2(1,2) = MISSING_R8
   ! variable C
   clamp_vals2(2,1) = MISSING_R8
   clamp_vals2(2,2) = 10.0_r8
   ! variable temp
   clamp_vals2(3,1) =  1.0_r8
   clamp_vals2(3,2) = 20.0_r8

   update_list2 = (/.true., .true., .false./)

   !!!! DOMAIN 5 !!!!

   ! infor for domain from spec
   var_names3 = (/'PS', 'T ', 'U ', 'V '/)
   kind_list3 = (/QTY_SURFACE_PRESSURE, QTY_TEMPERATURE, &
                  QTY_U_WIND_COMPONENT, QTY_V_WIND_COMPONENT/)
   ! variable PS
   clamp_vals3(1,1) = MISSING_R8
   clamp_vals3(1,2) = MISSING_R8
   ! variable T
   clamp_vals3(2,1) = MISSING_R8
   clamp_vals3(2,2) = 10.0_r8
   ! variable U
   clamp_vals3(3,1) = MISSING_R8
   clamp_vals3(3,2) = 10.0_r8
   ! variable V
   clamp_vals3(4,1) = MISSING_R8
   clamp_vals3(4,2) = 10.0_r8

   update_list3 = (/.false., .false., .false., .false./)

end subroutine initialize_domains

!----------------------------------------------------------------------

subroutine fill_domain_structure_for_spec(dom_id)
   integer,          intent(in) :: dom_id

   integer :: i
   do i = 1, get_num_variables(dom_id)
      if ( i >= 1) call add_dimension_to_variable(dom_id, i, 'dim1', nsd1)
      if ( i >= 2) call add_dimension_to_variable(dom_id, i, 'dim2', nsd2)
      if ( i >= 3) call add_dimension_to_variable(dom_id, i, 'dim3', nsd3)
      if ( i >= 4) call add_dimension_to_variable(dom_id, i, 'dim4', nsd4)
   enddo

   call finished_adding_domain(dom_id)

end subroutine fill_domain_structure_for_spec

!----------------------------------------------------------------------

subroutine test_sizes_domain(dom_id, exp_dom_size, exp_num_dom_vars, exp_unlim_dimid)
   integer, intent(in) :: dom_id
   integer, intent(in) :: exp_dom_size
   integer, intent(in) :: exp_num_dom_vars
   integer, intent(in) :: exp_unlim_dimid

   string1 = write_message_dom(dom_id, 'get_domain_size')
   intVal = get_domain_size(dom_id)
   call assert_equal(intVal, exp_dom_size, string1)

   string1 = write_message_dom(dom_id, 'get_num_variables')
   intVal = get_num_variables(dom_id)
   call assert_equal(intVal, exp_num_dom_vars, string1)

   string1 = write_message_dom(dom_id, 'get_unlimited_dimid')
   intVal = get_unlimited_dimid(dom_id)
   call assert_equal(intVal, exp_unlim_dimid, string1)

end subroutine test_sizes_domain

!----------------------------------------------------------------------

subroutine test_variable_info(dom_id, var_id, exp_var_size, exp_num_dims, exp_kind_indx, exp_kind_string, exp_var_name)
   integer, intent(in) :: dom_id
   integer, intent(in) :: var_id
   integer, intent(in) :: exp_var_size
   integer, intent(in) :: exp_num_dims
   integer, intent(in) :: exp_kind_indx
   character(len=*), intent(in) :: exp_kind_string
   character(len=*), intent(in) :: exp_var_name

   string1 = write_message_var(dom_id, var_id, 'get_variable_size ')
   intVal = get_variable_size(dom_id,var_id)
   call assert_equal(intVal, exp_var_size, string1)

   string1 = write_message_var(dom_id, var_id, 'get_variable_name ')
   varName = get_variable_name(dom_id,var_id)
   call assert_equal(varName, exp_var_name, string1)

   string1 = write_message_var(dom_id, var_id, 'get_num_dims ')
   intVal = get_num_dims(dom_id,var_id)
   call assert_equal(intVal, exp_num_dims, string1)

   string1 = write_message_var(dom_id, var_id, 'get_kind_string ')
   kindString = get_kind_string(dom_id,var_id)
   call assert_equal(kindString, exp_kind_string, string1)

   string1 = write_message_var(dom_id, var_id, 'get_kind_index ')
   intVal = get_kind_index(dom_id,var_id)
   call assert_equal(intVal, exp_kind_indx, string1)

end subroutine test_variable_info

!----------------------------------------------------------------------

subroutine test_dimension_info(dom_id, var_id, dim_ids, exp_io_numdims, exp_dim_names, exp_dim_lengths,  io_dim_ids, exp_io_dim_names, exp_io_dim_lengths, exp_io_dim_ids, exp_io_unique_dim_ids, exp_io_unique_numdims, exp_io_unique_dim_length, exp_io_unique_dim_names)
   integer,          intent(in) :: dom_id
   integer,          intent(in) :: var_id
   integer,          intent(in) :: dim_ids(:)
   character(len=*), intent(in) :: exp_dim_names(:)
   integer,          intent(in) :: exp_dim_lengths(:)
   integer,          intent(in) :: io_dim_ids(:)
   integer,          intent(in) :: exp_io_numdims
   character(len=*), intent(in) :: exp_io_dim_names(:)
   integer,          intent(in) :: exp_io_dim_lengths(:)
   integer,          intent(in) :: exp_io_dim_ids(:)
   integer,          intent(in) :: exp_io_unique_dim_ids(:)
   integer,          intent(in) :: exp_io_unique_numdims
   integer,          intent(in) :: exp_io_unique_dim_length(:)
   character(len=*), intent(in) :: exp_io_unique_dim_names(:)

   integer, allocatable :: int_array(:)
   integer :: i, num_dims

   ! user interface for dimensions

   num_dims = get_num_dims(dom_id,var_id)
   do i = 1,num_dims
      string1 = write_message_dim(dom_id, var_id, dim_ids(i), 'get_dim_name ')
      varName = get_dim_name(dom_id,var_id,dim_ids(i))
      call assert_equal(varName, exp_dim_names(i), string1)

      string1 = write_message_dim(dom_id, var_id, dim_ids(i), 'get_dim_length ')
      intVal = get_dim_length(dom_id,var_id,dim_ids(i))
      call assert_equal(intVal, exp_dim_lengths(i), string1)

   enddo

   allocate( int_array(num_dims) )

   string1 = write_message_var(dom_id, var_id, 'get_dim_lengths ')
   int_array = get_dim_lengths(dom_id,var_id)
   call assert_equal(int_array, exp_dim_lengths, string1)

   deallocate( int_array )

   string1 = write_message_var(dom_id, var_id, 'get_io_num_dims')
   num_dims = get_io_num_dims(dom_id, var_id)
   call assert_equal(num_dims, exp_io_numdims, string1)

   allocate( int_array(num_dims) )

   string1 = write_message_var(dom_id, var_id, 'get_io_dim_lengths ')
   int_array = get_io_dim_lengths(dom_id,var_id)
   call assert_equal(int_array, exp_io_dim_lengths, string1)

   deallocate( int_array )

   ! IO interface for dimensions
   num_dims = get_io_num_unique_dims(dom_id)
   do i = 1,num_dims
      string1 = write_message_dim(dom_id, var_id, exp_io_unique_dim_ids(i), 'get_io_unique_dim_name ')
      varName = get_io_unique_dim_name(dom_id,exp_io_unique_dim_ids(i))
      call assert_equal(varName, exp_io_unique_dim_names(i), string1)

      string1 = write_message_dim(dom_id, var_id, exp_io_unique_dim_ids(i), 'get_io_unique_dim_lengths ')
      intVal = get_io_unique_dim_length(dom_id,exp_io_unique_dim_ids(i))
      call assert_equal(intVal, exp_io_unique_dim_length(i), string1)

   enddo

   allocate( int_array(num_dims) )

   string1 = write_message_var(dom_id, var_id, 'get_io_dim_ids ')
   int_array = get_io_dim_ids(dom_id, var_id)
   call assert_equal(int_array, exp_io_dim_ids, string1)

   string1 = write_message_var(dom_id, var_id, 'get_io_num_unique_dims')
   intVal = get_io_num_unique_dims(dom_id)
   call assert_equal(intVal, exp_io_unique_numdims, string1)

   deallocate( int_array )

end subroutine test_dimension_info

!----------------------------------------------------------------------

subroutine test_update_and_clamping(dom_id, var_id, exp_clamp_min, exp_clamp_max, exp_clamping, exp_update)
   integer,  intent(in) :: dom_id
   integer,  intent(in) :: var_id
   real(r8), intent(in) :: exp_clamp_min
   real(r8), intent(in) :: exp_clamp_max
   logical,  intent(in) :: exp_clamping
   logical,  intent(in) :: exp_update

   string1 = write_message_var(dom_id, var_id, 'get_io_clamping_minval')
   realVal = get_io_clamping_minval(dom_id,var_id)
   call assert_equal(realVal, exp_clamp_min, string1)

   string1 = write_message_var(dom_id, var_id, 'get_io_clamping_maxval')
   realVal = get_io_clamping_maxval(dom_id,var_id)
   call assert_equal(realVal, exp_clamp_max, string1)

   string1 = write_message_var(dom_id, var_id, 'do_io_clamping')
   trueFalse = do_io_clamping(dom_id,var_id)
   call assert_equal(trueFalse, exp_clamping, string1)

   string1 = write_message_var(dom_id, var_id, 'do_io_update')
   trueFalse = do_io_update(dom_id,var_id)
   call assert_equal(trueFalse, exp_update, string1)

end subroutine test_update_and_clamping

!----------------------------------------------------------------------

subroutine test_indices(dom_id, var_id, var_name, exp_start, exp_end)
   integer,          intent(in) :: dom_id
   integer,          intent(in) :: var_id
   character(len=*), intent(in) :: var_name
   integer(i8),      intent(in) :: exp_start
   integer(i8),      intent(in) :: exp_end

   string1 = write_message_var(dom_id, var_id, 'get_index_start_from_varname')
   int8val = get_index_start(dom_id,var_name)
   call assert_equal(int8val, exp_start, string1)
   string1 = write_message_var(dom_id, var_id, 'get_index_start_from_varid')
   int8val = get_index_start(dom_id,var_id)
   call assert_equal(int8val, exp_start, string1)

   string1 = write_message_var(dom_id, var_id, 'get_index_end_from_varname')
   int8val = get_index_end(dom_id,var_name)
   call assert_equal(int8val, exp_end, string1)

   string1 = write_message_var(dom_id, var_id, 'get_index_end_from_varid')
   int8val = get_index_end(dom_id,var_id)
   call assert_equal(int8val, exp_end, string1)

end subroutine test_indices

!----------------------------------------------------------------------

subroutine test_sum_variables_below(dom_id, var_id1, var_id2, exp_sum_range, exp_sum_below1, exp_sum_below2)
   integer,     intent(in) :: dom_id
   integer,     intent(in) :: var_id1
   integer,     intent(in) :: var_id2
   integer(i8), intent(in) :: exp_sum_range
   integer(i8), intent(in) :: exp_sum_below1
   integer(i8), intent(in) :: exp_sum_below2

   string1 = write_message_2var(dom_id, var_id1, var_id2, 'get_sum_variables')
   int8Val = get_sum_variables(var_id1,var_id2,dom_id)
   call assert_equal(int8Val, exp_sum_range, string1)

   string1 = write_message_var(dom_id, var_id1, 'get_sum_variables_below')
   int8Val = get_sum_variables_below(var_id1,dom_id)
   call assert_equal(int8Val, exp_sum_below1, string1)

   string1 = write_message_var(dom_id, var_id2, 'get_sum_variables_below')
   int8Val = get_sum_variables_below(var_id2,dom_id)
   call assert_equal(int8Val, exp_sum_below2, string1)

end subroutine test_sum_variables_below

!----------------------------------------------------------------------

subroutine test_state_indicies(index_in, exp_iloc, exp_jloc, exp_kloc, exp_varid, exp_domid, exp_kind_index, exp_kind_string)
   integer(i8),      intent(in) :: index_in
   integer,          intent(in) :: exp_iloc
   integer,          intent(in) :: exp_jloc
   integer,          intent(in) :: exp_kloc
   integer,          intent(in) :: exp_varid
   integer,          intent(in) :: exp_domid
   integer,          intent(in) :: exp_kind_index
   character(len=*), intent(in) :: exp_kind_string

   integer :: iloc, jloc, kloc, var_id, dom_id, kind_index
   character(len=32) :: kind_string

   call get_model_variable_indices(index_in, iloc, jloc, kloc, var_id, &
                                   dom_id, kind_index, kind_string)

   string1 = write_message_indx(index_in, 'iloc',       'get_model_variable_indices')
   call assert_equal(iloc,       exp_iloc,         string1)
   string1 = write_message_indx(index_in, 'jloc',       'get_model_variable_indices')
   call assert_equal(jloc,       exp_jloc,         string1)
   string1 = write_message_indx(index_in, 'kloc',       'get_model_variable_indices')
   call assert_equal(kloc,       exp_kloc,         string1)
   string1 = write_message_indx(index_in, 'var_id',     'get_model_variable_indices')
   call assert_equal(var_id,     exp_varid,        string1)
   string1 = write_message_indx(index_in, 'dom_id',     'get_model_variable_indices')
   call assert_equal(dom_id,     exp_domid,        string1)
   string1 = write_message_indx(index_in, 'kind_index', 'get_model_variable_indices')
   call assert_equal(kind_index, exp_kind_index,   string1)
   string1 = write_message_indx(index_in, 'kind_string', 'get_model_variable_indices')
   call assert_equal(kind_string,exp_kind_string , string1)

   string1 = write_message_indx(index_in, 'index_out',    'get_dart_vector_index')
   int8Val = get_dart_vector_index(iloc, jloc, kloc, dom_id, var_id)
   call assert_equal(int8Val, index_in, string1)

end subroutine test_state_indicies

!----------------------------------------------------------------------

subroutine test_varids_from_kind(dom_id, kind_index, exp_num_varids_from_kind, exp_varids_from_kind)
   integer, intent(in) :: dom_id
   integer, intent(in) :: kind_index
   integer, intent(in) :: exp_num_varids_from_kind
   integer, intent(in) :: exp_varids_from_kind(:)

   integer :: size1, nVarIds
   integer, allocatable :: int_array(:)

   string1 = write_message_kind(dom_id, kind_index, 'get_num_varids_from_kind')
   nVarIds = get_num_varids_from_kind(dom_id, kind_index)
   call assert_equal(nVarIds, exp_num_varids_from_kind , string1)

   size1 = size(exp_varids_from_kind,1)
   allocate( int_array(size1) )

   string1 = write_message_kind(dom_id, kind_index, 'get_num_varids_from_kind')
   call get_varids_from_kind(dom_id, kind_index, int_array)
   call assert_equal(int_array, exp_varids_from_kind, string1)

   if ( nVarIds == 1 ) then ! only works for case when one to one maping of kinds and variables
      string1 = write_message_kind(dom_id, kind_index, 'get_varid_from_kind')
      intVal  = get_varid_from_kind(dom_id, kind_index)
      call assert_equal(intVal, exp_varids_from_kind(1), string1)
   endif

   deallocate( int_array )

end subroutine test_varids_from_kind

!----------------------------------------------------------------------

function find_domain(state_indx) result(dom)
   integer(i8), intent(in) :: state_indx
   integer :: dom

   integer :: idom

   dom = -1
   do idom = 1, get_num_domains()
      if ( state_indx >= msize(idom) .and. &
           state_indx <= msize(idom+1) ) then
         dom = idom
         return
      endif
   enddo

end function find_domain

!----------------------------------------------------------------------

function write_message_dom(dom_id, routine) result(msg)
   integer,          intent(in) :: dom_id
   character(len=*), intent(in) :: routine

   character(len=512) :: msg

   write(msg, '(''dom'',I1,'':'', A)') dom_id, trim(routine)

end function write_message_dom

!----------------------------------------------------------------------

function write_message_2var(dom_id, var_id1, var_id2, routine) result(msg)
   integer,          intent(in) :: dom_id
   integer,          intent(in) :: var_id1
   integer,          intent(in) :: var_id2
   character(len=*), intent(in) :: routine

   character(len=512) :: msg

   write(msg, '(''dom'',I1,'':var'',I0.2,'':var'',I0.2,'':'',A)') dom_id, var_id1, var_id2, trim(routine)

end function write_message_2var

!----------------------------------------------------------------------

function write_message_var(dom_id, var_id, routine) result(msg)
   integer,          intent(in) :: dom_id
   integer,          intent(in) :: var_id
   character(len=*), intent(in) :: routine

   character(len=512) :: msg

   write(msg, '(''dom'',I1,'':var'',I0.2,'':'',A)') dom_id, var_id, trim(routine)

end function write_message_var

!----------------------------------------------------------------------

function write_message_kind(dom_id, kind_index, routine) result(msg)
   integer,          intent(in) :: dom_id
   integer,          intent(in) :: kind_index
   character(len=*), intent(in) :: routine

   character(len=512) :: msg
   character(len=32)  :: kind_string

   kind_string = get_name_for_quantity(kind_index)

   write(msg, '(''dom'',I1,'':kind:'',A,'':'',A)') dom_id, kind_string, trim(routine)

end function write_message_kind

!----------------------------------------------------------------------

function write_message_dim(dom_id, var_id, dim_id, routine) result(msg)
   integer,          intent(in) :: dom_id
   integer,          intent(in) :: var_id
   integer,          intent(in) :: dim_id
   character(len=*), intent(in) :: routine

   character(len=512) :: msg

   write(msg, '(''dom'',I1,'':var'',I0.2'':dim'',I0.2,'':'',A)') dom_id, var_id, dim_id, trim(routine)

end function write_message_dim

!----------------------------------------------------------------------

function write_message_indx(index_in, test, routine) result(msg)
   integer(I8),      intent(in) :: index_in
   character(len=*), intent(in) :: test
   character(len=*), intent(in) :: routine

   character(len=512) :: msg

   write(msg, '(I4,A,'':'',A)') index_in, trim(test), trim(routine)

end function write_message_indx

!----------------------------------------------------------------------

subroutine initialize_module()

  call initialize_utilities('test_state_structure')
  call register_module(source, revision, revdate)

end subroutine initialize_module

end program

! <next few lines under version control, do not edit>
! $URL$
! $Id$
! $Revision$
! $Date$

max_stars_repo_name: hkershaw-brown/feature-preprocess

max_issues_repo_name: hkershaw-brown/feature-preprocess

max_forks_repo_name: hkershaw-brown/feature-preprocess