text:
       PROGRAM AVGFLX
C t3e:  f90 -o xavg avgflux.f
c arc:  lf95 -o xavg avgflux.f
       PARAMETER (MXT=10000,MXFIN=8,MXPIN=8)
       REAL TFLX(MXT),TPFLX(MXT),QI(MXT),QE(MXT),SUMI(MXT),SUME(MXT),
     1 DELT(MXT),PI(MXT),PE(MXT),ZTOT(MXT),SUMZT(MXT),ZTOTF(MXT),
     2 SUMZTF(MXT)
       integer ncarg,IUNIN/17/
       INTEGER ITTYWR/6/
C       INTEGER ITTYRD/5/,ITTYWR/6/
       CHARACTER*20 INFLX,run_name,time1,time2,short
       LOGICAL LOUT_SHORT/.FALSE./
C
       ncarg=iargc()
C LIB$SYS_TRNLOG is an obsolete System Service routine. Invoking it as
C a function returns a success code of 1 (1577: nonexistent logical name)
ccc       NTEST=LIB$SYS_TRNLOG('AVG_RUN',NTEST2,RUN_NAME)
cdbg       WRITE(6,'('' NTEST='',I5)') NTEST
c	NCARG=0
c       IF(NTEST.EQ.1) NCARG=1
       IF(NCARG.LT.1) THEN
         WRITE(ITTYWR,
     x   '('' Need command line arguments:'',/,
     2 ''%xavg run_name [time1] [time2] [oneline]'',/,
     3 ''  run_name (e.g, g14) is required'',/,
     4 ''  time1 is the averaging start time [optional]'',/,
     5 ''  time2 is the averaging end time [optional]'',/,
     6 ''  "oneline" reduces output for bulk processing'',/,
     7 '' Output:'',/,''  <tot> averages over all times'',/,
     8 ''  tdef is an automatically determined start time'',/,
     9 ''  <def> is average for tdef < t < end of file'',/,
     x ''  t1 & t2 are user input time1 & time2'',/,
     1 ''  <1-2> is average for t1 < t < t2'',/,
     2 ''  ts & te are start and end times for final averages'')')
         stop
       ENDIF
c t3e    CALL pxfgetarg(1,run_name,ilen,ierr)
       CALL getarg(1,run_name)
       IBLNK=INDEX(run_name,' ')
       INFLX=run_name(1:IBLNK-1)//'.flux'
       OPEN(UNIT=IUNIN,file=INFLX,status='old')
ccc       NTEST=LIB$SYS_TRNLOG('AVG_T1',NTEST2,time1)
cdbg       WRITE(6,'('' NTEST='',I5)') NTEST
ccc       IF(NTEST.EQ.1) NCARG=2
       IF(NCARG.GE.2) then
c t3e         CALL pxfgetarg(2,time1,ilen,ierr)
         CALL getarg(2,time1)
         IF(TIME1.EQ.'oneline') THEN
           LOUT_SHORT=.TRUE.
           T1=0.
         ELSE
           READ(time1,*) T1
         ENDIF
       ELSE
         T1=0.
       ENDIF
ccc       NTEST=LIB$SYS_TRNLOG('AVG_T2',NTEST2,time2)
cdbg       WRITE(6,'('' NTEST='',I5)') NTEST
ccc       IF(NTEST.EQ.1) NCARG=3
       IF(NCARG.GE.3) then
c t3e         CALL pxfgetarg(3,time2,ilen,ierr)
         CALL getarg(3,time2)
         IF(TIME2.EQ.'oneline') THEN
           LOUT_SHORT=.TRUE.
           T2=0.
         ELSE
           READ(time2,*) T2
         ENDIF
       ELSE
         T2=0.
       ENDIF
ccc       NTEST=LIB$SYS_TRNLOG('AVG_ONE',NTEST2,SHORT)
cdbg       WRITE(6,'('' NTEST='',I5)') NTEST
ccc       IF(NTEST.EQ.1) NCARG=4
       IF(NCARG.GE.4) then
c t3e      CALL pxfgetarg(4,short,ilen,ierr)
         CALL getarg(4,short)
         IF(short.EQ.'oneline') LOUT_SHORT=.TRUE.
         IF(short.EQ.'ONELINE') LOUT_SHORT=.TRUE.
       ENDIF
C
       ICOUNT=0
 100   CONTINUE
C12345678(1)2345678(2)2345678(3)2345678(4)2345678(5)2345678(6)2345678(7)
       READ(IUNIN,'(T3,E17.10,T55,E11.4,T66,E11.4)',
     X ERR=900,END=200) ZTIME,ZQI,ZQE
       ICOUNT=ICOUNT+1
       IF(ICOUNT.GT.MXT) THEN
         WRITE(ITTYWR,'('' Arrays too short; need larger MXT'')')
         stop
       ENDIF
       TFLX(ICOUNT)=ZTIME
       QI(ICOUNT)=ZQI
       QE(ICOUNT)=ZQE
       GO TO 100
 200   CONTINUE
       IF(T1.GT.TFLX(1)) THEN
         IT1=0
       ELSE
         IT1=1
       ENDIF
       IF(T2.LT.TFLX(ICOUNT)) THEN
         IT2=0
         IF(T2.LT.TFLX(IT1)) IT2=ICOUNT
         IF(T2.LT.0.) IT2=ICOUNT
       ELSE
         IT2=ICOUNT
       ENDIF
       SUMI(1)=0.
       SUME(1)=0.
       DO J=1,ICOUNT-1
         DELT(J)=TFLX(J+1)-TFLX(J)
         SUMI(J+1)=SUMI(J)+QI(J)*DELT(J)
         SUME(J+1)=SUME(J)+QE(J)*DELT(J)
         IF(IT1.EQ.0 .AND. TFLX(J).LE.T1 .AND. TFLX(J+1).GT.T1) IT1=J
         IF(IT2.EQ.0 .AND. TFLX(J).LE.T2 .AND. TFLX(J+1).GT.T2) IT2=J
       ENDDO
 210   CONTINUE
       AVGTOTI=SUMI(ICOUNT)/(TFLX(ICOUNT)-TFLX(1))
       AVGTOTE=SUME(ICOUNT)/(TFLX(ICOUNT)-TFLX(1))
       IF(IT2.EQ.0) IT2=ICOUNT
       AVGUI=(SUMI(IT2)-SUMI(IT1))/(TFLX(IT2)-TFLX(IT1))
       AVGUE=(SUME(IT2)-SUME(IT1))/(TFLX(IT2)-TFLX(IT1))
C
       QIPEAK=0.
       ITIPEAK=1
       ITIDEF=1
       DO J=1,ICOUNT-1
         AVGDEFI=(SUMI(ICOUNT)-SUMI(J))/(TFLX(ICOUNT)-TFLX(J))
C  Don't look for default time until the initial peak has been passed
C  if this is a run from t=0:
         IF(TFLX(1).LT.10.) THEN
           IF(QIPEAK.LE.0. .AND. QI(J).GT.10.
     1       .AND. QI(J+1).LT.QI(J)) THEN
             QIPEAK=QI(J)
             ITIPEAK=J
           ENDIF
         ELSE
           QIPEAK=1.
         ENDIF
         IF(QIPEAK.GT.0. .AND. QI(J).LT.AVGDEFI) THEN
           TDEFI=TFLX(J)
           ITIDEF=J
           GO TO 220
         ENDIF
       ENDDO
 220   CONTINUE
       QEPEAK=0.
       ITEDEF=1
       DO J=1,ICOUNT-1
         AVGDEFE=(SUME(ICOUNT)-SUME(J))/(TFLX(ICOUNT)-TFLX(J))
C  Don't look for default time until the initial peak has been passed
C  if this is a run from t=0:
         IF(TFLX(1).LT.10.) THEN
           IF(QEPEAK.LE.0. .AND. QE(J).GT.10. .AND.
     1        QE(J+1).LT.QE(J)) QEPEAK=QE(J)
         ELSE
           QEPEAK=1.
         ENDIF
         IF(QEPEAK.GT.0. .AND. QE(J).LT.AVGDEFE) THEN
           TDEFE=TFLX(J)
           ITEDEF=J
           GO TO 230
         ENDIF
       ENDDO
 230   CONTINUE
       IF(LOUT_SHORT) GO TO 299
       WRITE(ITTYWR,'(5X,''<tot>  tdef  <def>    t1   t2  <1-2>'')')
       WRITE(ITTYWR,'('' Qi'',0PF7.2,2X,I4,0PF7.2,2X,I4,X,I4,0PF7.2)')
     1 AVGTOTI,IFIX(TDEFI+0.5),AVGDEFI,IFIX(TFLX(IT1)+0.5),
     2 IFIX(TFLX(IT2)+0.5),AVGUI
       WRITE(ITTYWR,'('' Qe'',0PF7.2,2X,I4,0PF7.2,2X,I4,X,I4,0PF7.2)')
     1 AVGTOTE,IFIX(TDEFE+0.5),AVGDEFE,IFIX(TFLX(IT1)+0.5),
     2 IFIX(TFLX(IT2)+0.5),AVGUE
C
 299   CONTINUE
       CLOSE(IUNIN)
       PI=0.
       PE=0.
       INFLX=run_name(1:IBLNK-1)//'.plux'
       OPEN(UNIT=IUNIN,file=INFLX,status='old',err=400)
       ICNTP=0
 300   CONTINUE
C12345678(1)2345678(2)2345678(3)2345678(4)2345678(5)2345678(6)2345678(7)
       READ(IUNIN,'(T3,E17.10,T55,E11.4,T66,E11.4)',
     X ERR=900,END=400) ZTIME,ZPI,ZPE
       ICNTP=ICNTP+1
       IF(ICNTP.GT.MXT) THEN
         WRITE(ITTYWR,'('' Arrays too short; need larger MXT'')')
         stop
       ENDIF
       TPFLX(ICNTP)=ZTIME
       PI(ICNTP)=ZPI
       PE(ICNTP)=ZPE
       ZTOT(ICNTP)=ABS(ZPI-ZPE)
       ZTOTF(ICNTP)=ABS(ZPI-ZPE)/AMAX1(ABS(ZPE),ABS(ZPI))
       GO TO 300
 400   CONTINUE
       SUMI(1)=0.
       SUME(1)=0.
       SUMZT(1)=0.
       SUMZTF(1)=0.
       DO J=1,ICNTP-1
         DELT(J)=TPFLX(J+1)-TPFLX(J)
         SUMI(J+1)=SUMI(J)+PI(J)*DELT(J)
         SUME(J+1)=SUME(J)+PE(J)*DELT(J)
         SUMZT(J+1)=SUMZT(J)+ZTOT(J)*DELT(J)
         SUMZTF(J+1)=SUMZTF(J)+ZTOTF(J)*DELT(J)
       ENDDO
       ITP1=IT1
       ITP2=MIN0(ICNTP,IT2)
       AVGTPI=SUMI(ICNTP)/(TPFLX(ICNTP)-TPFLX(1))
       AVGTPE=SUME(ICNTP)/(TPFLX(ICNTP)-TPFLX(1))
       AVGUPI=(SUMI(ITP2)-SUMI(ITP1))/(TPFLX(ITP2)-TPFLX(ITP1))
       AVGUPE=(SUME(ITP2)-SUME(ITP1))/(TPFLX(ITP2)-TPFLX(ITP1))
       AVGTZT=SUMZT(ICNTP)/(TPFLX(ICNTP)-TPFLX(1))
       AVGUZT=(SUMZT(ITP2)-SUMZT(ITP1))/(TPFLX(ITP2)-TPFLX(ITP1))
       AVGTZTF=SUMZTF(ICNTP)/(TPFLX(ICNTP)-TPFLX(1))
       AVGUZTF=(SUMZTF(ITP2)-SUMZTF(ITP1))/(TPFLX(ITP2)-TPFLX(ITP1))
C
       DO J=ITIDEF,ICNTP-1
         AVGDPI=(SUMI(ICNTP)-SUMI(J))/(TPFLX(ICNTP)-TPFLX(J))
         IF(PI(J).LT.AVGDPI) THEN
           TDEFPI=TPFLX(J)
           AVGDZT=(SUMZT(ICNTP)-SUMZT(J))/(TPFLX(ICNTP)-TPFLX(J))
           AVGDZTF=(SUMZTF(ICNTP)-SUMZTF(J))/(TPFLX(ICNTP)-TPFLX(J))
           GO TO 420
         ENDIF
       ENDDO
 420   CONTINUE
       DO J=1,ICNTP-1
         AVGDPE=(SUME(ICNTP)-SUME(J))/(TPFLX(ICNTP)-TPFLX(J))
         IF(PE(J).LT.AVGDPE) THEN
           TDEFPE=TPFLX(J)
           GO TO 430
         ENDIF
       ENDDO
 430   CONTINUE
       IF(LOUT_SHORT) GO TO 499
       WRITE(ITTYWR,'('' Pi'',0PF7.2,2X,I4,0PF7.2,2X,I4,X,I4,0PF7.2)')
     1 AVGTPI,IFIX(TDEFPI+0.5),AVGDPI,IFIX(TPFLX(IT1)+0.5),
     2 IFIX(TPFLX(IT2)+0.5),AVGUPI
       WRITE(ITTYWR,'('' Zt'',0PF7.2,2X,I4,0PF7.2,2X,I4,X,I4,0PF7.2)')
     1 AVGTZT,IFIX(TDEFPI+0.5),AVGDZT,IFIX(TPFLX(IT1)+0.5),
     2 IFIX(TPFLX(IT2)+0.5),AVGUZT
       WRITE(ITTYWR,'('' Zf'',0PF7.2,2X,I4,0PF7.2,2X,I4,X,I4,0PF7.2)')
     1 AVGTZTF,IFIX(TDEFPI+0.5),AVGDZTF,IFIX(TPFLX(IT1)+0.5),
     2 IFIX(TPFLX(IT2)+0.5),AVGUZTF
C
       WRITE(ITTYWR,
     1 '(/,3X,'' ts   te    Qi     Qe     Pi'',27X,''Zt/Pi   Ztf'')')
C
 499   CONTINUE
       IF(T1.LE.0) THEN
         ST1=TDEFI
         ST2=TFLX(ICOUNT)
         SAVGI=AVGDEFI
         SAVGE=AVGDEFE
         SAVGPI=AVGDPI
         SAVGZT=AVGDZT
         SAVGZTF=AVGDZTF
         CALL GETRMS(TFLX,QI,ITIDEF,ICOUNT,TAVGI,TRMSI)
         CALL GETRMS(TFLX,QE,ITEDEF,ICOUNT,TAVGE,TRMSE)
         CALL GETRMS(TPFLX,PI,ITIDEF,ICNTP,TAVGP,TRMSP)
         CALL GETRMS(TPFLX,ZTOT,ITIDEF,ICNTP,TAVGZT,TRMSZT)
         CALL GETRMS(TPFLX,ZTOTF,ITIDEF,ICNTP,TAVGZTF,TRMSZTF)
       ELSE
         ST1=TFLX(IT1)
         ST2=TFLX(IT2)
         SAVGI=AVGUI
         SAVGE=AVGUE
         SAVGPI=AVGUPI
         SAVGZT=AVGUZT
         SAVGZTF=AVGUZTF
         CALL GETRMS(TFLX,QI,IT1,IT2,TAVGI,TRMSI)
         CALL GETRMS(TFLX,QE,IT1,IT2,TAVGE,TRMSE)
         CALL GETRMS(TPFLX,PI,IT1,IT2,TAVGP,TRMSP)
         CALL GETRMS(TPFLX,ZTOT,IT1,IT2,TAVGZT,TRMSZT)
         CALL GETRMS(TPFLX,ZTOTF,IT1,IT2,TAVGZTF,TRMSZTF)
       ENDIF
c       WRITE(ITTYWR,'(2X,I4,X,I4,X,0P3F7.2,2X,A)')
c     1 IFIX(ST1+0.5),IFIX(ST2+0.5),SAVGI,SAVGE,SAVGPI,RUN_NAME
       WRITE(ITTYWR,'(2X,I4,X,I4,X,0P3F7.2,2X,A,X,0P2F7.3)')
     1 IFIX(ST1+0.5),IFIX(ST2+0.5),TAVGI,TAVGE,TAVGP,RUN_NAME,
     2 TAVGZT/TAVGP,TAVGZTF
       IF(.NOT.LOUT_SHORT)WRITE(ITTYWR,
     1 '('' rms var:   '',0P3F7.2,23X,0P2F7.3)')
     2  TRMSI,TRMSE,TRMSP,TRMSZT/TAVGP,TRMSZTF
C
       stop
 900   CONTINUE
       WRITE(ITTYWR,'('' ERROR reading file '',A20)') INFLX
       stop
       END
C/ MODULE GETRMS
      SUBROUTINE GETRMS(PRTIM,PRFUN,KSTART,KEND,PAVG,PRMS)
C
      INTEGER I,KSTART,KEND
      REAL PRTIM(KEND),PRFUN(KEND),PRMS
C
      PAVG=0.
      DO I=KSTART,KEND-1
        PAVG=PAVG+0.5*(PRFUN(I)+PRFUN(I+1))*(PRTIM(I+1)-PRTIM(I))/
     1  (PRTIM(KEND)-PRTIM(KSTART))
      ENDDO
C
      PRMS=0.
      DO I=KSTART,KEND-1
        PRMS=PRMS+(0.5*(PRFUN(I)+PRFUN(I+1))-PAVG)**2*
     1  (PRTIM(I+1)-PRTIM(I))/(PRTIM(KEND)-PRTIM(KSTART))
      ENDDO
      PRMS=SQRT(PRMS) ! root mean square deviation.
      RETURN
      END


module fMathClass
  use iso_c_binding

  implicit none

  !type(c_ptr) :: pa
  !integer(c_int)::n

  interface
    subroutine testc(pa) bind(c)
      use iso_c_binding
      type(c_ptr):: pa
    end subroutine testc
  end interface

  interface
    subroutine addValVec(pa,n,i,val_in) bind(c)
      use iso_c_binding
      type(c_ptr):: pa
      integer(c_int),value:: i
      integer(c_int),value:: n
      real(c_double),value::val_in

    end subroutine addValVec
  end interface

  interface
    subroutine putValVec(pa,n,i,val_in) bind(c)
      use iso_c_binding
      type(c_ptr):: pa
      integer(c_int),value:: i
      integer(c_int),value:: n
      real(c_double),value::val_in

    end subroutine putValVec
  end interface

  interface
    subroutine setZeroVec(pa,n) bind(c)
      use iso_c_binding
      type(c_ptr):: pa
      integer(c_int),value:: n

    end subroutine setZeroVec
  end interface

  interface
    subroutine initVec(pa,n) bind(c)
      use iso_c_binding
      type(c_ptr):: pa
      integer(c_int),value:: n

    end subroutine initVec
  end interface

  interface
    subroutine c_allocatev(pa,n) bind(c)
      use iso_c_binding
      type(c_ptr):: pa
      integer(c_int),value:: n

    end subroutine c_allocatev
  end interface

  interface
    function dotproduct(pa,pa2,n) result(val) bind(c)
      use iso_c_binding
      type(c_ptr):: pa,pa2
      integer(c_int),value:: n
      real(c_double):: val
    end function dotproduct
  end interface

  interface
    function opencl_dotproduct(pa,pa2,n) result(val) bind(c)
      use iso_c_binding
      type(c_ptr):: pa,pa2
      integer(c_int),value:: n
      real(c_double):: val
    end function opencl_dotproduct
  end interface

  interface
    function opencl_dotproduct_f(pa,pa2,n) result(val) bind(c)
      use iso_c_binding
      type(c_ptr):: pa,pa2
      integer(c_int),value:: n
      real(c_float):: val
    end function opencl_dotproduct_f
  end interface

contains

  subroutine showValue()
    type(c_ptr) :: pa
    real(c_double),pointer::fpa(:)
    real(c_double)::val
    double precision, allocatable,target :: vec(:),vec2(:)
    integer(c_int)::n
    integer :: i

    n=10000
    allocate(vec(n) )

    do i=1,n
      val=dble(i)
      call putValVec(pa,n,i,val)
    enddo

    call c_f_pointer(pa, fpa, [n])

    vec(:)= fpa(:)

    print *, vec(:)
  end subroutine

  function c_dot_product(a,b,nf) result(dp)
    use iso_c_binding
    integer,intent(in)::nf
    real(8),intent(in),target::a(nf),b(nf)
    real(4),target::a_f(nf),b_f(nf)
    double precision, pointer ::fpa(:),fpb(:)
    real(4), pointer ::fpa_f(:),fpb_f(:)

    real(8) :: dp
    real(4) :: dp_f

    type(c_ptr) :: pa
    type(c_ptr) :: pa2

    type(c_ptr) :: pa_f
    type(c_ptr) :: pa2_f

    real(c_double)::val
    real(c_float)::val_f
    integer(c_int)::n
    integer :: i

    do i=1,nf
      a_f(i)=real(a(i) )
      b_f(i)=real(b(i) )
    enddo

    fpa => a
    fpb => b

    n=nf
    !call c_f_pointer(fpa, a, [n])
    !call c_f_pointer(fpb, b, [n])
    call c_allocatev(pa,n)
    call c_f_pointer(pa, fpa, [n])
    fpa(:)=a(:)
    call c_allocatev(pa2,n)
    call c_f_pointer(pa2, fpb, [n])
    fpb(:)=b(:)

    dp_f= opencl_dotproduct(pa,pa2,n)
    print *, dp

  end function c_dot_product

  function c_dot_product_f(a,b,nf) result(dp)
    use iso_c_binding
    integer,intent(in)::nf
    real(8),intent(in),target::a(nf),b(nf)
    real(4),target::a_f(nf),b_f(nf)
    double precision, pointer ::fpa(:),fpb(:)
    real(4), pointer ::fpa_f(:),fpb_f(:)

    real(8) :: dp
    real(4) :: dp_f

    type(c_ptr) :: pa
    type(c_ptr) :: pa2

    type(c_ptr) :: pa_f
    type(c_ptr) :: pa2_f

    real(c_double)::val
    real(c_float)::val_f
    integer(c_int)::n
    integer :: i

    do i=1,nf
      a_f(i)=real(a(i) )
      b_f(i)=real(b(i) )
    enddo

    !fpa => a
    !fpb => b

    n=nf
    !call c_f_pointer(fpa, a, [n])
    !call c_f_pointer(fpb, b, [n])
    !call c_allocatev(pa,n)
    !call c_f_pointer(pa, fpa, [n])
    !fpa(:)=a(:)
    !call c_allocatev(pa2,n)
    !call c_f_pointer(pa2, fpb, [n])
    !fpb(:)=b(:)

    ! pointer
    fpa_f => a_f
    fpb_f => b_f

    call c_allocatev(pa_f,n)
    call c_f_pointer(pa_f, fpa_f, [n])
    fpa_f(:)=a_f(:)
    call c_allocatev(pa2_f,n)
    call c_f_pointer(pa2_f, fpb_f, [n])
    fpb_f(:)=b_f(:)

    dp_f= opencl_dotproduct_f(pa_f,pa2_f,n)
    print *, dp

  end function c_dot_product_f

end module fMathClass


MODULE OMSAO_he5_module

  ! ==============================
  ! Module for HDF-EOS5 parameters
  ! ==============================

  USE OMSAO_precision_module
  USE OMSAO_parameters_module, ONLY: &
       maxchlen, i2_missval, i4_missval, r4_missval, r8_missval, blank13,       &
       valid_max_i2, valid_max_i4, valid_min_r8, valid_max_r8, zero_r8, one_r8, &
       elsunc_usrstop_eval_r8, elsunc_highest_eval_r8,                          &
       main_qa_min_flag_r8, main_qa_max_flag_r8
  USE OMSAO_indices_module,    ONLY: &
       n_sao_pge, max_calfit_idx, sao_pge_min_idx, sao_pge_max_idx, &
       o3_t1_idx, o3_t3_idx

  IMPLICIT NONE

  CHARACTER (LEN=12), PARAMETER :: aushar = "Aura-Shared ", omspec = "OMI-Specific"

  ! -----------------------------------------------------------------
  ! Blank strings of various lengths.
  !
  ! Some compilers don't allow to define CHARACTER PARAMETER arrays
  ! which are initialized with field of unequal length. The following
  ! are a few padding strings that we attach to shorter entries. Not
  ! very stylish, but effective. Note that what matters is the LEN
  ! declaration - we don't need to initialize the strings with the
  ! appropriate number of blanks. Using "" is perfectly fine.
  ! -----------------------------------------------------------------
  CHARACTER (LEN=12), PARAMETER :: blk12 = ""
  CHARACTER (LEN=13), PARAMETER :: blk13 = ""
  CHARACTER (LEN=14), PARAMETER :: blk14 = ""
  CHARACTER (LEN=16), PARAMETER :: blk16 = ""
  CHARACTER (LEN=17), PARAMETER :: blk17 = ""
  CHARACTER (LEN=19), PARAMETER :: blk19 = ""
  CHARACTER (LEN=20), PARAMETER :: blk20 = ""
  CHARACTER (LEN=21), PARAMETER :: blk21 = ""
  CHARACTER (LEN=23), PARAMETER :: blk23 = ""
  CHARACTER (LEN=25), PARAMETER :: blk25 = ""
  CHARACTER (LEN=26), PARAMETER :: blk26 = ""
  CHARACTER (LEN=27), PARAMETER :: blk27 = ""
  CHARACTER (LEN=28), PARAMETER :: blk28 = ""
  CHARACTER (LEN=29), PARAMETER :: blk29 = ""
  CHARACTER (LEN=30), PARAMETER :: blk30 = ""
  CHARACTER (LEN=31), PARAMETER :: blk31 = ""
  CHARACTER (LEN=32), PARAMETER :: blk32 = ""
  CHARACTER (LEN=33), PARAMETER :: blk33 = ""
  CHARACTER (LEN=35), PARAMETER :: blk35 = ""
  CHARACTER (LEN=38), PARAMETER :: blk38 = ""
  CHARACTER (LEN=39), PARAMETER :: blk39 = ""
  CHARACTER (LEN=40), PARAMETER :: blk40 = ""
  CHARACTER (LEN=41), PARAMETER :: blk41 = ""
  CHARACTER (LEN=43), PARAMETER :: blk43 = ""
  CHARACTER (LEN=45), PARAMETER :: blk45 = ""
  CHARACTER (LEN=48), PARAMETER :: blk48 = ""
  CHARACTER (LEN=49), PARAMETER :: blk49 = ""

  ! ----------------------------------------------
  ! Swath IDs for current HE5 swath and swath file
  ! ----------------------------------------------
  INTEGER (KIND=i4) :: pge_swath_file_id, pge_swath_id

  ! --------------------------------------------------------------
  ! Swath IDs for pre-fitted BrO and O3 HE5 swaths and swath files
  ! --------------------------------------------------------------
  CHARACTER (LEN=maxchlen) :: &
       o3fit_swath_name    = 'undefined', &
       brofit_swath_name   = 'undefined', &
       lqh2ofit_swath_name = 'undefined'
  INTEGER   (KIND=i4) :: &
       o3fit_swath_id    = -1, o3fit_swath_file_id    = -1, &
       brofit_swath_id   = -1, brofit_swath_file_id   = -1, &
       lqh2ofit_swath_id = -1, lqh2ofit_swath_file_id = -1

  ! --------------------
  ! Fill Value attribute
  ! --------------------
  CHARACTER (LEN=12), PARAMETER :: missval_attr = "MissingValue"
  CHARACTER (LEN= 6), PARAMETER :: offset_attr  = "Offset"
  CHARACTER (LEN=11), PARAMETER :: scafac_attr  = "ScaleFactor"
  CHARACTER (LEN= 5), PARAMETER :: title_attr   = "Title"
  CHARACTER (LEN=10), PARAMETER :: valids_attr  = "ValidRange"
  CHARACTER (LEN= 5), PARAMETER :: units_attr   = "Units"
  CHARACTER (LEN=28), PARAMETER :: rstemp_attr  = "ReferenceSpectrumTemperature"
  CHARACTER (LEN=21), PARAMETER :: ufd_attr     = "UniqueFieldDefinition"

  ! ----------------------------------
  ! Strings for Global File Attributes
  ! ----------------------------------
  CHARACTER (LEN=18), PARAMETER :: tai_attr = "TAI93At0zOfGranule"

  ! -----------------------------------------------
  ! Variables that will hold Global File Attributes
  ! -----------------------------------------------
  CHARACTER (LEN=maxchlen) :: &
       pge_swath_name, process_level, instrument_name, pge_version, l1b_orbitdata
  INTEGER   (KIND=i4)      :: granule_day, granule_month, granule_year
  REAL      (KIND=r8)      :: TAI93At0zOfGranule

  ! ----------------------
  ! Swath Level Attributes
  ! ----------------------
  CHARACTER (LEN=18), PARAMETER :: vcoordinate_field = "VerticalCoordinate"

  ! ----------------
  ! Swath dimensions
  ! ----------------
  CHARACTER (LEN= 6), PARAMETER :: ntc   = "nTimes"
  CHARACTER (LEN= 7), PARAMETER :: nxc   = "nXtrack"
  CHARACTER (LEN= 7), PARAMETER :: nlc   = "nLevels"    ! GGA
  CHARACTER (LEN= 8), PARAMETER :: ntcp1 = "nTimes+1"   ! GGA
  CHARACTER (LEN= 9), PARAMETER :: nxcp1 = "nXtrack+1"  ! GGA
  CHARACTER (LEN=12), PARAMETER :: nfv   = "nFitElements"
  CHARACTER (LEN=19), PARAMETER :: ncv   = "nCharLenFitElements"
  CHARACTER (LEN=11), PARAMETER :: ncwvl = "nCommonWavl"
  CHARACTER (LEN= 7), PARAMETER :: nutcd = "nUTCdim"
  CHARACTER (LEN=11), PARAMETER :: nwcp  = "nWavCalPars"
  CHARACTER (LEN=14), PARAMETER :: nxtc  = nxc//","//ntc
  CHARACTER (LEN=27), PARAMETER :: nfxtc = nfv//","//nxc//","//ntc
  CHARACTER (LEN=19), PARAMETER :: nxwcp = nwcp//","//nxc
  CHARACTER (LEN=22), PARAMETER :: nxtlc = nxc//","//ntc//","//nlc !GGA

    ! CCM Add one for the refspec database
    CHARACTER (LEN= 7), PARAMETER :: nrspc = "nRfSpec"
    CHARACTER (LEN=10), PARAMETER :: nwalm = "nwavel_max"
  ! ------------------------
  ! Swath geolocation fields
  ! ------------------------
  CHARACTER (LEN=18), PARAMETER ::  auraalt_field = "SpacecraftAltitude"
  CHARACTER (LEN= 4), PARAMETER ::  time_field    = "Time"
  CHARACTER (LEN= 7), PARAMETER ::  utc_field     = "TimeUTC"
  CHARACTER (LEN=13), PARAMETER ::  thgt_field    = "TerrainHeight"
  CHARACTER (LEN=10), PARAMETER ::  scno_field    = "ScanNumber"
  CHARACTER (LEN= 8), PARAMETER ::  lat_field     = "Latitude"
  CHARACTER (LEN= 9), PARAMETER ::  lon_field     = "Longitude"
  CHARACTER (LEN=17), PARAMETER ::  saa_field     = "SolarAzimuthAngle"
  CHARACTER (LEN=16), PARAMETER ::  sza_field     = "SolarZenithAngle"
  CHARACTER (LEN=19), PARAMETER ::  vaa_field     = "ViewingAzimuthAngle"
  CHARACTER (LEN=18), PARAMETER ::  vza_field     = "ViewingZenithAngle"
  CHARACTER (LEN=18), PARAMETER ::  xtr_field     = "XtrackQualityFlags"
  CHARACTER (LEN=26), PARAMETER ::  extr_field    = "XtrackQualityFlagsExpanded"

  ! -----------------
  ! Swath data fields
  ! -----------------
  CHARACTER (LEN=27), PARAMETER ::  amfdiag_field  = "AirMassFactorDiagnosticFlag"
  CHARACTER (LEN=22), PARAMETER ::  amfgeo_field   = "AirMassFactorGeometric"
  CHARACTER (LEN=13), PARAMETER ::  amfmol_field   = "AirMassFactor"
  CHARACTER (LEN=25), PARAMETER ::  amferrpr_field = "AirMassFactorErrorProfile"
  CHARACTER (LEN=24), PARAMETER ::  amferral_field = "AirMassFactorErrorAlbedo"
  CHARACTER (LEN=31), PARAMETER ::  amferrcf_field = "AirMassFactorErrorCloudFraction"
  CHARACTER (LEN=31), PARAMETER ::  amferrcp_field = "AirMassFactorErrorCloudPressure"
  CHARACTER (LEN=19), PARAMETER ::  avgcol_field   = "AverageColumnAmount"
  CHARACTER (LEN=24), PARAMETER ::  avgdcol_field  = "AverageColumnUncertainty"
  CHARACTER (LEN=17), PARAMETER ::  avgrms_field   = "AverageFittingRMS"
  CHARACTER (LEN=12), PARAMETER ::  col_field      = "ColumnAmount"
  CHARACTER (LEN=18), PARAMETER ::  commspc_field  = "CommonModeSpectrum"
  CHARACTER (LEN=21), PARAMETER ::  commwvl_field  = "CommonModeWavelengths"
  CHARACTER (LEN=17), PARAMETER ::  dcol_field     = "ColumnUncertainty"
  CHARACTER (LEN=21), PARAMETER ::  dstrcol_field  = "ColumnAmountDestriped"
  CHARACTER (LEN=18), PARAMETER ::  fitcon_field   = "FitConvergenceFlag"
  CHARACTER (LEN=10), PARAMETER ::  fitrms_field   = "FittingRMS"
  CHARACTER (LEN=19), PARAMETER ::  mainqa_field   = "MainDataQualityFlag"
  CHARACTER (LEN=19), PARAMETER ::  maxcol_field   = "MaximumColumnAmount"
  CHARACTER (LEN=20), PARAMETER ::  pxclat_field   = "PixelCornerLatitudes"
  CHARACTER (LEN=21), PARAMETER ::  pxclon_field   = "PixelCornerLongitudes"
  CHARACTER (LEN= 9), PARAMETER ::  pxarea_field   = "PixelArea"

	! CCM Add field for fit residuals
	CHARACTER (LEN=14), PARAMETER ::  spcfit_field   = "FittedSpectrum"
	CHARACTER (LEN=16), PARAMETER ::  spcobs_field   = "MeasuredSpectrum"
	CHARACTER (LEN=18), PARAMETER ::  posobs_field   = "MeasuredWavelength"
	CHARACTER (LEN=17), PARAMETER ::  fitwt_field    = "SpectralFitWeight"
	CHARACTER (LEN=16), PARAMETER ::  spcres_field   = "ResidualSpectrum"
	! Spectral Database
	CHARACTER (LEN=12), PARAMETER ::  spdata_field   = "DatabaseSpec"
	CHARACTER (LEN=12), PARAMETER ::  spdatw_field   = "DatabaseWavl"
	CHARACTER (LEN=17), PARAMETER ::  spname_field   = "DatabaseSpecNames"
	CHARACTER (LEN=18), PARAMETER ::  spnrmf_field   = "DatabaseNormFactor"

  ! -------------------------------------------------------
  ! Special data fields for wavelength-modified AMF fitting
  ! -------------------------------------------------------
  CHARACTER (LEN=20), PARAMETER ::  adalb_field     = "AdjustedSceneAlbedo"
  CHARACTER (LEN=18), PARAMETER ::  scol_field      = "SlantColumnAmount"
  CHARACTER (LEN=22), PARAMETER ::  sdcol_field     = "SlantColumnUncertainty"
  CHARACTER (LEN=26), PARAMETER ::  sdstrcol_field  = "SlantColumnAmountDestriped"
  CHARACTER (LEN=23), PARAMETER ::  sfitcon_field   = "SlantFitConvergenceFlag"
  CHARACTER (LEN=15), PARAMETER ::  sfitrms_field   = "SlantFittingRMS"

  CHARACTER (LEN=29), PARAMETER ::  rrcol_field    = "RadianceReferenceColumnAmount"
  CHARACTER (LEN=34), PARAMETER ::  rrdcol_field   = "RadianceReferenceColumnUncertainty"
  CHARACTER (LEN=29), PARAMETER ::  rrxcol_field   = "RadianceReferenceColumnXTRFit"
  CHARACTER (LEN=27), PARAMETER ::  rrrms_field    = "RadianceReferenceFittingRMS"
  CHARACTER (LEN=20), PARAMETER ::  rrfi_field     = "RadianceReferenceFit"
  CHARACTER (LEN=32), PARAMETER ::  rrcf_field     = "RadianceReferenceConvergenceFlag"
  CHARACTER (LEN=31), PARAMETER ::  rric_field     = "RadianceReferenceIterationCount"
  CHARACTER (LEN=30), PARAMETER ::  rrlr_field     = "RadianceReferenceLatitudeRange"

  CHARACTER (LEN=17), PARAMETER ::  rwcfi_field    = "RadianceWavCalFit"
  CHARACTER (LEN=29), PARAMETER ::  rwccf_field    = "RadianceWavCalConvergenceFlag"
  CHARACTER (LEN=28), PARAMETER ::  rwcic_field    = "RadianceWavCalIterationCount"
  CHARACTER (LEN=27), PARAMETER ::  rwclr_field    = "RadianceWavCalLatitudeRange"

  CHARACTER (LEN=14), PARAMETER ::  swcfi_field    = "SolarWavCalFit"
  CHARACTER (LEN=26), PARAMETER ::  swccf_field    = "SolarWavCalConvergenceFlag"
  CHARACTER (LEN=25), PARAMETER ::  swcic_field    = "SolarWavCalIterationCount"

  ! --------------------------------------------------
  ! Swath data fields, additional in "diagnostic" runs
  ! --------------------------------------------------
  CHARACTER (LEN=13), PARAMETER ::  ccdpix_field   = "CCDPixelRange"
  CHARACTER (LEN=15), PARAMETER ::  commcnt_field  = "CommonModeCount"
  CHARACTER (LEN=28), PARAMETER ::  corr_field     = "FittingParameterCorrelations"
  CHARACTER (LEN=23), PARAMETER ::  corrcol_field  = "FittingParameterColumns"
  CHARACTER (LEN=21), PARAMETER ::  correlm_field  = "FittingParameterNames"
  CHARACTER (LEN=27), PARAMETER ::  correrr_field  = "FittingParameterUncertainty"
  CHARACTER (LEN=14), PARAMETER ::  itnum_field    = "IterationCount"
  CHARACTER (LEN=26), PARAMETER ::  xtrcor_field   = "CrossTrackStripeCorrection"

  ! -----------------------------------------------
  ! Swath data fields unique to OMHCHO and OMCHOCHO
  ! -----------------------------------------------
  CHARACTER (LEN=16), PARAMETER ::  amfcfr_field   = "AMFCloudFraction"
  CHARACTER (LEN=16), PARAMETER ::  amfctp_field   = "AMFCloudPressure"

    ! -------------------------------------- GGA
    ! Swath data fields for Reference Sector GGA
    ! -------------------------------------- GGA
    CHARACTER (LEN=38), PARAMETER :: rscol_field     = "ReferenceSectorCorrectedVerticalColumn"
    CHARACTER (LEN=35), PARAMETER :: rscod_field     = "ReferenceSectorCorrectedUncertainty"

    ! ---------------------------------------------------------------------- GGA
    ! Swath data field for Scattering Weights, Gas Profile Averaging Kernels GGA
    ! and albedo                                                             GGA
    ! ---------------------------------------------------------------------- GGA
    CHARACTER (LEN=17), PARAMETER :: scaweights_field = "ScatteringWeights"
    CHARACTER (LEN=10), PARAMETER :: gasprofile_field = "GasProfile"
    CHARACTER (LEN=19), PARAMETER :: surfacepre_field = "SurfacePressure"
    CHARACTER (LEN= 6), PARAMETER :: albedo_field     = "Albedo"

  ! ------------------
  ! Geolocation fields
  ! ------------------
  INTEGER (KIND=i4), PARAMETER :: n_gfields = 12
  CHARACTER (LEN=34), DIMENSION (2,n_gfields), PARAMETER ::  &
       geo_field_names = RESHAPE ( (/ &
       "Latitude                          ","Geodetic Latitude                 ",    &
       "Longitude                         ","Geodetic Longitude                ",    &
       "SolarAzimuthAngle                 ","Solar Azimuth Angle               ",    &
       "SolarZenithAngle                  ","Solar Zenith Angle                ",    &
       "SpacecraftAltitude                ","Altitude of Aura Spacecraft       ",    &
       "TerrainHeight                     ","Terrain Height                    ",    &
       "Time                              ","Time in TAI units                 ",    &
       "TimeUTC                           ","Coordianted Universal Time        ",    &
       "ViewingAzimuthAngle               ","Viewing Azimuth Angle             ",    &
       "ViewingZenithAngle                ","Viewing Zenith Angle              ",    &
       "XtrackQualityFlags                ","Cross-Track Quality Flags         ",    &
       "XtrackQualityFlagsExpanded        ","Expanded Cross-Track Quality Flags"  /),&
       (/ 2, n_gfields /) )
  CHARACTER (LEN=14), DIMENSION (4,n_gfields), PARAMETER ::  &
       geo_field_specs = RESHAPE ( (/ &
       "deg           ","nXtrack,nTimes","Aura-Shared   ","r4            ",    &
       "deg           ","nXtrack,nTimes","Aura-Shared   ","r4            ",    &
       "deg           ","nXtrack,nTimes","Aura-Shared   ","r4            ",    &
       "deg           ","nXtrack,nTimes","Aura-Shared   ","r4            ",    &
       "m             ","nTimes        ","Aura-Shared   ","r4            ",    &
       "m             ","nXtrack,nTimes","Aura-Shared   ","i2            ",    &
       "s             ","nTimes        ","Aura-Shared   ","r8            ",    &
       "NoUnits       ","nUTCdim,nTimes","OMI-Specific  ","i2            ",    &
       "deg           ","nXtrack,nTimes","OMI-Specific  ","r4            ",    &
       "deg           ","nXtrack,nTimes","OMI-Specific  ","r4            ",    &
       "NoUnits       ","nXtrack,nTimes","OMI-Specific  ","i1            ",    &
       "NoUnits       ","nXtrack,nTimes","OMI-Specific  ","i2            "  /),&
       (/ 4, n_gfields /) )
  REAL (KIND=r8), DIMENSION ( 2, n_gfields ), PARAMETER :: &
       geo_valids = RESHAPE (       (/  &
       -90.0_r8,     +90.0_r8,          &
       -180.0_r8,   +180.0_r8,          &
       -180.0_r8,   +180.0_r8,          &
       zero_r8,     +180.0_r8,          &
       zero_r8,     ABS(r8_missval),    &
       -1000.0_r8,  10000.0_r8,         &
       zero_r8,     1.0E+10_r8,         &
       0.0_r8,      9999.0_r8,          &
       -180.0_r8,   +180.0_r8,          &
       zero_r8,     +180.0_r8,          &
       zero_r8,     +127.0_r8,          &
       zero_r8,     +11147.0_r8     /), &
       (/ 2, n_gfields /) )

  ! --------------------------------------------
  ! Data fields for Solar Wavelength Calibration
  ! --------------------------------------------
  INTEGER (KIND=i4), PARAMETER :: n_solcal_fields = 1
  CHARACTER (LEN=45), DIMENSION ( 2, n_solcal_fields ), PARAMETER :: &
       solcal_field_names = RESHAPE ( (/ &
       "SolarWavCalConvergenceFlag                   ",     &
       "Solar Wavelength Calibration Convergence Flag"  /), &
       (/ 2, n_solcal_fields /) )
  CHARACTER (LEN=12), DIMENSION ( 4, n_solcal_fields ), PARAMETER :: &
       solcal_field_specs = RESHAPE ( (/ &
       "NoUnits     ","nXtrack     ","OMI-Specific","i2          " /),&
       (/ 4, n_solcal_fields /) )
  REAL (KIND=r8), DIMENSION ( 2, n_solcal_fields ), PARAMETER :: &
       solcal_valids = RESHAPE ( (/ &
       elsunc_usrstop_eval_r8, elsunc_highest_eval_r8 /), &
       (/ 2, n_solcal_fields /) )

  ! -----------------------------------------------
  ! Data fields for Radiance Wavelength Calibration
  ! ----------------------------------------------------------------------
  ! NOTE: First N_SOLCAL_FIELDS must be the same type as in SOLCAL_FIELDS,
  !       since this is what is assumed in the output routine.
  ! ----------------------------------------------------------------------
  INTEGER (KIND=i4), PARAMETER :: n_radcal_fields = 2
  CHARACTER (LEN=48), DIMENSION ( 2, n_radcal_fields ), PARAMETER :: &
       radcal_field_names = RESHAPE ( (/ &
       "RadianceWavCalConvergenceFlag                   ", "Radiance Wavelength Calibration Convergence Flag",   &
       "RadianceWavCalLatitudeRange                     ", "Radiance Wavelength Calibration Latitude Range  " /),&
       (/ 2, n_radcal_fields /) )
  CHARACTER (LEN=12), DIMENSION ( 4, n_radcal_fields ), PARAMETER :: &
       radcal_field_specs = RESHAPE ( (/ &
       "NoUnits     ", "nXtrack     ", "OMI-Specific", "i2          ",    &
       "NoUnits     ", "4           ", "OMI-Specific", "r4          "  /),&
       (/ 4, n_radcal_fields /) )
  REAL (KIND=r8), DIMENSION ( 2, n_radcal_fields ), PARAMETER :: &
       radcal_valids = RESHAPE ( (/ &
       elsunc_usrstop_eval_r8, elsunc_highest_eval_r8,    &
       -90.0_r8,               90.0_r8                /), &
       (/ 2, n_radcal_fields /) )

  ! -----------------------------------------------
  ! Data fields for Radiance Reference Fit
  ! ----------------------------------------------------------------------
  ! NOTE: First N_SOLCAL_FIELDS must be the same type as in SOLCAL_FIELDS,
  !       since this is what is assumed in the output routine.
  ! ----------------------------------------------------------------------
  INTEGER (KIND=i4), PARAMETER :: n_radref_fields = 6
  CHARACTER (LEN=42), DIMENSION ( 2, n_radref_fields ), PARAMETER :: &
       radref_field_names = RESHAPE ( (/ &
       "RadianceReferenceConvergenceFlag          ", "Radiance Reference Fit Convergence Flag   ",    &
       "RadianceReferenceLatitudeRange            ", "Radiance Reference Fit Latitude Range     ",    &
       "RadianceReferenceColumnAmount             ", "Radiance Reference Fit Column Amount      ",    &
       "RadianceReferenceColumnUncertainty        ", "Radiance Reference Fit Column Uncertainty ",    &
       "RadianceReferenceColumnXTRFit             ", "Radiance Reference Fit Column XTR Fit     ",    &
       "RadianceReferenceFittingRMS               ", "Radiance Reference Fit RMS                "  /),&
       (/ 2, n_radref_fields /) )
  CHARACTER (LEN=12), DIMENSION ( 4, n_radref_fields ), PARAMETER :: &
       radref_field_specs = RESHAPE ( (/ &
       "NoUnits     ", "nXtrack     ", "OMI-Specific", "i2          ",   &
       "NoUnits     ", "4           ", "OMI-Specific", "r4          ",   &
       "molec/cm2   ", "nXtrack     ", "OMI-Specific", "r8          ",   &
       "molec/cm2   ", "nXtrack     ", "OMI-Specific", "r8          ",   &
       "molec/cm2   ", "nXtrack     ", "OMI-Specific", "r8          ",   &
       "NoUnits     ", "nXtrack     ", "OMI-Specific", "r8          " /),&
       (/ 4, n_radref_fields /) )
  REAL (KIND=r8), DIMENSION ( 2, n_radref_fields ), PARAMETER :: &
       radref_valids = RESHAPE ( (/ &
       elsunc_usrstop_eval_r8, elsunc_highest_eval_r8,    &
       -90.0_r8,               90.0_r8,                   &
       valid_min_r8,           valid_max_r8,              &
       zero_r8,                valid_max_r8,              &
       valid_min_r8,           valid_max_r8,              &
       zero_r8,                valid_max_r8           /), &
       (/ 2, n_radref_fields /) )

  ! -----------
  ! Data Fields
  ! -----------

  ! ------------------------------------------------------------
  ! (1) Main common output quantities ( mostly [nTimes,nXtrack])
  ! ------------------------------------------------------------
  INTEGER (KIND=i4), PARAMETER :: n_cdfields = 19
  CHARACTER (LEN=41), DIMENSION (2,n_cdfields), PARAMETER ::  &
       comdata_field_names = RESHAPE ( (/ &
       "AirMassFactor                            ", "Molecule Specific Air Mass Factor (AMF)  ",    &
       "AirMassFactorDiagnosticFlag              ", "Diagnostic Flag for Molecule Specific AMF",    &
       "AirMassFactorGeometric                   ", "Geometric Air Mass Factor (AMF)          ",    &
       "AirMassFactorErrorProfile                ", "Air Mass Factor Error Profile            ",    &
       "AirMassFactorErrorAlbedo                 ", "Air Mass Factor Error Albedo             ",    &
       "AirMassFactorErrorCloudFraction          ", "Air Mass Factor Error Cloud Fraction     ",    &
       "AirMassFactorErrorCloudPressure          ", "Air Mass Factor Error Cloud Pressure     ",    &
       "AverageColumnAmount                      ", "Average Column Amount                    ",    &
       "AverageColumnUncertainty                 ", "Average Column Uncertainty               ",    &
       "AverageFittingRMS                        ", "Average Fitting RMS                      ",    &
       "ColumnAmount                             ", "Column Amount                            ",    &
       "ColumnAmountDestriped                    ", "Column Amount with Destriping Correction ",    &
       "ColumnUncertainty                        ", "Column Uncertainty                       ",    &
       "FittingRMS                               ", "Fitting RMS                              ",    &
       "FitConvergenceFlag                       ", "Fitting Convergence Flag                 ",    &
       "MainDataQualityFlag                      ", "Main Data Quality Flag                   ",    &
       "MaximumColumnAmount                      ", "Maximum Column Amount for QA Flag 'good' ",    &
       "PixelCornerLatitudes                     ", "Pixel Corner Latitude Coordinates        ",    &
       "PixelCornerLongitudes                    ", "Pixel Corner Longitude Coordinates       " /), &
!!$       "PixelArea                                ", "Pixel Area                               " /), &
       (/ 2, n_cdfields /) )
  CHARACTER (LEN=18), DIMENSION (4,n_cdfields), PARAMETER ::  &
       comdata_field_specs = RESHAPE ( (/ &
       "NoUnits           ", "nXtrack,nTimes    ", "OMI-Specific      ", "r4                ",    &
       "NoUnits           ", "nXtrack,nTimes    ", "OMI-Specific      ", "i2                ",    &
       "NoUnits           ", "nXtrack,nTimes    ", "OMI-Specific      ", "r4                ",    &
       "NoUnits           ", "nXtrack,nTimes    ", "OMI-Specific      ", "r4                ",    &
       "NoUnits           ", "nXtrack,nTimes    ", "OMI-Specific      ", "r4                ",    &
       "NoUnits           ", "nXtrack,nTimes    ", "OMI-Specific      ", "r4                ",    &
       "NoUnits           ", "nXtrack,nTimes    ", "OMI-Specific      ", "r4                ",    &
       "molec/cm2         ", "1                 ", "OMI-Specific      ", "r8                ",    &
       "molec/cm2         ", "1                 ", "OMI-Specific      ", "r8                ",    &
       "NoUnits           ", "1                 ", "OMI-Specific      ", "r8                ",    &
       "molec/cm2         ", "nXtrack,nTimes    ", "OMI-Specific      ", "r8                ",    &
       "molec/cm2         ", "nXtrack,nTimes    ", "OMI-Specific      ", "r8                ",    &
       "molec/cm2         ", "nXtrack,nTimes    ", "OMI-Specific      ", "r8                ",    &
       "NoUnits           ", "nXtrack,nTimes    ", "OMI-Specific      ", "r8                ",    &
       "NoUnits           ", "nXtrack,nTimes    ", "OMI-Specific      ", "i2                ",    &
       "NoUnits           ", "nXtrack,nTimes    ", "OMI-Specific      ", "i2                ",    &
       "molec/cm2         ", "1                 ", "OMI-Specific      ", "r8                ",    &
       "deg               ", "nXtrack+1,nTimes+1", "OMI-Specific      ", "r4                ",    &
       "deg               ", "nXtrack+1,nTimes+1", "OMI-Specific      ", "r4                ",    &
       "km^2              ", "nXtrack           ", "OMI-Specific      ", "r4                " /), &
       (/ 4, n_cdfields /) )
  ! -----------------------------------------------------------------
  ! Note that the VALIDS for FittingCorrelationElements are not used;
  ! they are only here to make this array of the same dimension as
  ! the others, and so eliminates the need for additional CASE logic.
  ! -----------------------------------------------------------------
  REAL (KIND=r8), DIMENSION ( 2, n_cdfields ), PARAMETER ::    &
       comdata_valids = RESHAPE ( (/                           &
       zero_r8,                valid_max_r8,                   &  ! AirMassFactor
       -2.0_r8,                13127.0_r8,                     &  ! AirMassFactorDiagnosticFlag
       zero_r8,                valid_max_r8,                   &  ! AirMassFactorGeometric
       zero_r8,                valid_max_r8,                   &  ! AirMassFactorErrorProfile
       zero_r8,                valid_max_r8,                   &  ! AirMassFactorErrorAlbedo
       zero_r8,                valid_max_r8,                   &  ! AirMassFactorErrorCloudFraction
       zero_r8,                valid_max_r8,                   &  ! AirMassFactorErrorCloudPressure
       valid_min_r8,           valid_max_r8,                   &  ! AverageColumnAmount
       zero_r8,                valid_max_r8,                   &  ! AverageColumnUncertainty
       zero_r8,                valid_max_r8,                   &  ! AverageFittingRMS
       valid_min_r8,           valid_max_r8,                   &  ! ColumnAmount
       valid_min_r8,           valid_max_r8,                   &  ! ColumnAmountDestriped
       zero_r8,                valid_max_r8,                   &  ! ColumnUncertainty
       zero_r8,                valid_max_r8,                   &  ! FittingRMS
       elsunc_usrstop_eval_r8, elsunc_highest_eval_r8,         &  ! FitConvergenceFlag
       main_qa_min_flag_r8,    main_qa_max_flag_r8,            &  ! MainDataQualityFlag
       valid_min_r8,           valid_max_r8,                   &  ! MaximumColumnAmount
       -90.0_r8,               +90.0_r8,                       &  ! PixelCornerLatitudes
       -180.0_r8,              +180.0_r8,                      &  ! PixelCornerLongitudes
       0.0_r8,                 180.0_r8*360.0_r8*6378.0_r8 /), &  ! PixelArea
       (/ 2, n_cdfields /) )

  ! -------------------------------------------
  ! (2) Additional fields for "diagnostic" runs
  ! -------------------------------------------

  ! CCM n_diag_fields 10 -> 18
  INTEGER (KIND=i4), PARAMETER :: n_diag_fields = 19

  ! CCM Add All fit residuals
  CHARACTER (LEN=41), DIMENSION (2,n_diag_fields), PARAMETER ::  &
       diagnostic_field_names = RESHAPE ( (/ &
       "CCDPixelRange                            ", "First and Last CCD Pixel Number Fitted   ",    &
       "CommonModeCount                          ", "Common Mode Spectrum Averaging Count     ",    &
       "CommonModeSpectrum                       ", "Common Mode Spectrum                     ",    &
       "CommonModeWavelengths                    ", "Common Mode Spectrum Wavelengths         ",    &
       "CrossTrackStripeCorrection               ", "Correction Factor for Cross Track Stripes",    &
       "FittingParameterColumns                  ", "Colum Values of all Fitting Parameters   ",    &
       "FittingParameterCorrelations             ", "Correlations with Main Fitting Parameter ",    &
       "FittedSpectrum                           ", "Fitted Spectrum                          ",    &
       "MeasuredSpectrum                         ", "Observed L1B Radiance                    ",    &
       "MeasuredWavelength                       ", "Spectral Position of L1B Radiance        ",    &
       "SpectralFitWeight                        ", "Weighting of L1B Radiance Pixel          ",    &
       "FittingParameterNames                    ", "Names of all Fitting Parameters          ",    &
       "FittingParameterUncertainty              ", "Uncertainties of all Fitting Parameters  ",    &
       "DatabaseSpec                             ", "Reference Spectra used in fitting process",    &
       "DatabaseWavl                             ", "Reference Spectra Wavelengths            ",    &
       "DatabaseNormFactor                       ", "Normalisation factors for DatabaseSpec   ",    &
       "DatabaseSpecNames                        ", "Species Names for DatabaseSpec           ",    &
       "IterationCount                           ", "Radiance Fit Iteration Count             ",    &
       "ResidualSpectrum                         ",	"Residual Spectrum                        " /), &
       (/ 2, n_diag_fields /) )
  CHARACTER (LEN=27), DIMENSION (4,n_diag_fields), PARAMETER ::  &
       diagnostic_field_specs = RESHAPE ( (/ &
       "NoUnits                    ","nXtrack,2                  ","OMI-Specific               ","i2                         ",   &
       "NoUnits                    ","nXtrack                    ","OMI-Specific               ","i4                         ",   &
       "molec/cm2                  ","nXtrack,nCommonWavl        ","OMI-Specific               ","r8                         ",   &
       "nm                         ","nXtrack,nCommonWavl        ","OMI-Specific               ","r4                         ",   &
       "NoUnit                     ","nXtrack,nTimes             ","OMI-Specific               ","r8                         ",   &
       "NoUnits                    ","nFitElements,nXtrack,nTimes","OMI-Specific               ","r8                         ",   &
       "NoUnits                    ","nFitElements,nXtrack,nTimes","OMI-Specific               ","r8                         ",   &
       "NoUnits                    ","nCommonWavl,nXtrack,nTimes ","OMI-Specific               ","r8                         ",   &
       "NoUnits                    ","nCommonWavl,nXtrack,nTimes ","OMI-Specific               ","r8                         ",   &
       "NoUnits                    ","nCommonWavl,nXtrack,nTimes ","OMI-Specific               ","r8                         ",   &
       "NoUnits                    ","nCommonWavl,nXtrack,nTimes ","OMI-Specific               ","r8                         ",   &
       "NoUnits                    ","nCharLenFitElements        ","OMI-Specific               ","ch                         ",   &
       "NoUnits                    ","nFitElements,nXtrack,nTimes","OMI-Specific               ","r8                         ",   &
       "NoUnits                    ","nRfSpec,nwavel_max,nXtrack ","OMI-Specific               ","r8                         ",   &
       "nm                         ","nwavel_max,nXtrack         ","OMI-Specific               ","r8                         ",   &
       "NoUnits                    ","nRfSpec                    ","OMI-Specific               ","r8                         ",   &
       "NoUnits                    ","nRfSpec                    ","OMI-Specific               ","ch                         ",   &
       "NoUnits                    ","nXtrack,nTimes             ","OMI-Specific               ","i2                         ",   &
       "NoUnits                    ","nCommonWavl,nXtrack,nTimes ","OMI-Specific               ","r8                         " /),&
       (/ 4, n_diag_fields /) )

  ! Output control logicals CCM
  LOGICAL, DIMENSION ( n_diag_fields ) :: &
  		 yn_output_diag = (/ .TRUE. ,&  ! CCDPixelRange
                           .TRUE. ,&  ! CommonModeCount
                           .TRUE. ,&  ! CommonModeSpectrum
                           .TRUE. ,&  ! CommonModeWavelengths
                           .TRUE. ,&  ! CrossTrackStripeCorrection
                           .TRUE. ,&  ! FittingParameterColumns
                           .TRUE. ,&  ! FittingParameterCorrelations
                           .TRUE. ,&  ! FittedSpectrum
                           .TRUE. ,&  ! MeasuredSpectrum
                           .TRUE. ,&  ! MeasuredWavelength
                           .TRUE. ,&  ! SpectralFitWeight
                           .TRUE. ,&  ! FittingParameterNames
                           .TRUE. ,&  ! FittingParameterUncertainty
                           .TRUE. ,&  ! DatabaseSpec
                           .TRUE. ,&  ! DatabaseWavl
                           .TRUE. ,&  ! DatabaseNormFactor
                           .TRUE. ,&  ! DatabaseSpecNames
                           .TRUE. ,&  ! IterationCount
                           .TRUE. /)  ! ResidualSpectrum

  ! -----------------------------------------------------------------
  ! Note that the VALIDS for FittingCorrelationElements are not used;
  ! they are only here to make this array of the same dimension as
  ! the others, and so eliminates the need for additional CASE logic.
  ! -----------------------------------------------------------------
  REAL (KIND=r8), DIMENSION ( 2, n_diag_fields ), PARAMETER :: &
       diagnostic_valids = RESHAPE ( (/          &
       1.0_r8,                 780.0_r8,         &  ! CCDPixelRange
       zero_r8,                valid_max_i4,     &  ! CommonModeCount
       valid_min_r8,           valid_max_r8,     &  ! CommonModeSpectrum
       valid_min_r8,           valid_max_r8,     &  ! CommonModeWavelengths
       valid_min_r8,           valid_max_r8,     &  ! CrossTrackStripeCorrection
       valid_min_r8,           valid_max_r8,     &  ! FittingParameterColumns
       valid_min_r8,           valid_max_r8,     &  ! FittingParameterCorrelations
       valid_min_r8,           valid_max_r8,     &  ! FittedSpectrum
       valid_min_r8,           valid_max_r8,     &  ! MeasuredSpectrum
       valid_min_r8,           valid_max_r8,     &  ! MeasuredWavelength
       valid_min_r8,           valid_max_r8,     &  ! SpectralFitWeight
       0.0_r8,                 valid_max_i2,     &  ! FittingParameterNames
       zero_r8,                valid_max_r8,     &  ! FittingParameterUncertainty
       valid_min_r8,           valid_max_r8,     &  ! DatabaseSpec
       valid_min_r8,           valid_max_r8,     &  ! DatabaseWavl
       valid_min_r8,           valid_max_r8,     &  ! DatabaseNormFactor
       0.0_r8,                 valid_max_i2,     &  ! DatabaseSpecNames
       0.0_r8,                 valid_max_i2,     &  ! IterationCount
       valid_min_r8,           valid_max_r8  /), &  ! ResidualSpectrum
       (/ 2, n_diag_fields /) )

  ! ----------------------------------------------------------------
  ! (3) Additional output for OMHCHO/OMCHOCHO: Adjusted Cloud Fields
  ! ----------------------------------------------------------------
  INTEGER (KIND=i4), PARAMETER :: n_cld_fields = 2
  CHARACTER (LEN=43), DIMENSION (2,n_cld_fields), PARAMETER ::  &
       cld_field_names = RESHAPE ( (/ &
       "AMFCloudFraction"//blk27, "Adjusted Cloud Fraction for AMF Computation",    &
       "AMFCloudPressure"//blk27, "Adjusted Cloud Pressure for AMF Computation" /), &
       (/ 2, n_cld_fields /) )
  CHARACTER (LEN=14), DIMENSION (4,n_cld_fields), PARAMETER ::  &
       cld_field_specs = RESHAPE ( (/ &
       "NoUnits       ", "nXtrack,nTimes", "OMI-Specific  ","r4            ",     &
       "hPa           ", "nXtrack,nTimes", "OMI-Specific  ","r4            "  /), &
       (/ 4, n_cld_fields /) )
  INTEGER (KIND=i4), PARAMETER :: n_voc_fields = 2
  CHARACTER (LEN=43), DIMENSION (2,n_voc_fields), PARAMETER ::  &
       voc_field_names = RESHAPE ( (/ &
       "AMFCloudFraction"//blk27, "Adjusted Cloud Fraction for AMF Computation",    &
       "AMFCloudPressure"//blk27, "Adjusted Cloud Pressure for AMF Computation" /), &
       (/ 2, n_voc_fields /) )
  CHARACTER (LEN=14), DIMENSION (4,n_voc_fields), PARAMETER ::  &
       voc_field_specs = RESHAPE ( (/ &
       "NoUnits       ", "nXtrack,nTimes", "OMI-Specific  ","r4            ",     &
       "hPa           ", "nXtrack,nTimes", "OMI-Specific  ","r4            "  /), &
       (/ 4, n_voc_fields /) )

  ! -----------------------------------------------------------------
  ! Note that the VALIDS for FittingCorrelationElements are not used;
  ! they are only here to make this array of the same dimension as
  ! the others, and so eliminates the need for additional CASE logic.
  ! -----------------------------------------------------------------
  REAL (KIND=r8), DIMENSION ( 2, n_cld_fields ), PARAMETER :: &
       cld_valids = RESHAPE ( (/                 &
       zero_r8,                +1.0_r8,          &  ! AMFCloudFraction
       zero_r8,                valid_max_r8  /), &  ! AMFCloudPressure
       (/ 2, n_cld_fields /) )
  REAL (KIND=r8), DIMENSION ( 2, n_voc_fields ), PARAMETER :: &
       voc_valids = RESHAPE ( (/                 &
       zero_r8,                +1.0_r8,          &  ! AMFCloudFraction
       zero_r8,                valid_max_r8  /), &  ! AMFCloudPressure
       (/ 2, n_voc_fields /) )

  ! ------------------------------------------------------------
  ! (4) Special output for Wavelength-Modified AMF fitting
  ! ------------------------------------------------------------
  INTEGER (KIND=i4), PARAMETER :: n_wmamf_fields = 6
  CHARACTER (LEN=47), DIMENSION (2, n_wmamf_fields), PARAMETER ::  &
       wmamf_field_names = RESHAPE ( (/ &
       "AdjustedSceneAlbedo                            ", "Adjusted Scene Albedo                          ",    &
       "SlantColumnAmount                              ", "Slant Column Amount                            ",    &
       "SlantColumnAmountDestriped                     ", "Slant Column Amount with Destriping Correction ",    &
       "SlantColumnUncertainty                         ", "Slant Column Uncertainty                       ",    &
       "SlantFittingRMS                                ", "Slant Fitting RMS                              ",    &
       "SlantFitConvergenceFlag                        ", "Slant Fitting Convergence Flag                 " /), &
       (/ 2, n_wmamf_fields /) )
  CHARACTER (LEN=18), DIMENSION (4,n_wmamf_fields), PARAMETER ::  &
       wmamf_field_specs = RESHAPE ( (/ &
       "NoUnits           ", "nXtrack,nTimes    ", "OMI-Specific      ", "r4                ",    &
       "molec/cm2         ", "nXtrack,nTimes    ", "OMI-Specific      ", "r8                ",    &
       "molec/cm2         ", "nXtrack,nTimes    ", "OMI-Specific      ", "r8                ",    &
       "molec/cm2         ", "nXtrack,nTimes    ", "OMI-Specific      ", "r8                ",    &
       "NoUnits           ", "nXtrack,nTimes    ", "OMI-Specific      ", "r8                ",    &
       "NoUnits           ", "nXtrack,nTimes    ", "OMI-Specific      ", "i2                " /), &
       (/ 4, n_wmamf_fields /) )
  ! -----------------------------------------------------------------
  ! Note that the VALIDS for FittingCorrelationElements are not used;
  ! they are only here to make this array of the same dimension as
  ! the others, and so eliminates the need for additional CASE logic.
  ! -----------------------------------------------------------------
  REAL (KIND=r8), DIMENSION ( 2, n_wmamf_fields ), PARAMETER :: &
       wmamf_valids = RESHAPE ( (/                              &
       zero_r8,                one_r8,                          &  ! ColumnAmount
       valid_min_r8,           valid_max_r8,                    &  ! ColumnAmount
       valid_min_r8,           valid_max_r8,                    &  ! ColumnAmountDestriped
       zero_r8,                valid_max_r8,                    &  ! ColumnUncertainty
       zero_r8,                valid_max_r8,                    &  ! FittingRMS
       elsunc_usrstop_eval_r8, elsunc_highest_eval_r8      /),  &  ! FitConvergenceFlag
       (/ 2, n_wmamf_fields /) )

  ! -----------------------------
  ! (5) Special output for OMSAO3
  ! ---------------------------------------------------------------------
  ! This we leave in its pedestrian structure of multiple arrays for the
  ! string definitions. Figuring out the logic of a RESHAPE in three
  ! dimensions is just too much of a headache for now (tpk, 16 Oct '04)
  ! ---------------------------------------------------------------------
  INTEGER   (KIND=i4), PARAMETER :: n_o3fields = o3_t3_idx - o3_t1_idx + 1
  CHARACTER (LEN=35), DIMENSION (o3_t1_idx:o3_t3_idx, 2), PARAMETER ::  &
       o3_prefit_fields = RESHAPE ( (/ &
       "SlantColumnAmountTemperatureT1     ", &
       "SlantColumnAmountTemperatureT2     ", &
       "SlantColumnAmountTemperatureT3     ", &
       "SlantColumnUncertaintyTemperatureT1", &
       "SlantColumnUncertaintyTemperatureT2", &
       "SlantColumnUncertaintyTemperatureT3"  /), (/ n_o3fields, 2 /) )
  CHARACTER (LEN=42), DIMENSION (o3_t1_idx:o3_t3_idx, 2), PARAMETER ::  &
       o3_prefit_fields_titles = RESHAPE ( (/ &
       "Slant Column Amount at Temperature T1     ", &
       "Slant Column Amount at Temperature T2     ", &
       "Slant Column Amount at Temperature T3     ", &
       "Slant Column Uncertainty at Temperature T1", &
       "Slant Column Uncertainty at Temperature T2", &
       "Slant Column Uncertainty at Temperature T3"/), &
       (/ n_o3fields, 2 /) )
  CHARACTER (LEN=12), DIMENSION ( o3_t1_idx:o3_t3_idx, 2 ), PARAMETER :: &
       o3_prefit_fields_ufd = RESHAPE ( (/ &
       omspec, omspec, omspec,     &
       omspec, omspec, omspec  /), &
       (/ n_o3fields, 2 /) )
  CHARACTER (LEN= 9), DIMENSION ( o3_t1_idx:o3_t3_idx, 2 ), PARAMETER :: &
       o3_prefit_fields_units = RESHAPE ( (/ &
       "molec/cm2", "molec/cm2", "molec/cm2", "molec/cm2", "molec/cm2", "molec/cm2" /), &
       (/ n_o3fields, 2 /) )
  CHARACTER (LEN=14), DIMENSION ( o3_t1_idx:o3_t3_idx, 2 ), PARAMETER :: &
       o3_prefit_fields_dims  = RESHAPE ( (/ &
       nxtc, nxtc, nxtc, nxtc, nxtc, nxtc /), &
       (/ n_o3fields, 2 /) )
  REAL (KIND=r8), DIMENSION ( 2, o3_t1_idx:o3_t3_idx, 2 ), PARAMETER :: &
       o3_prefit_valids = RESHAPE ( (/ &
       valid_min_r8, valid_max_r8, valid_min_r8, valid_max_r8, &
       valid_min_r8, valid_max_r8, valid_min_r8, valid_max_r8, &
       valid_min_r8, valid_max_r8, valid_min_r8, valid_max_r8  /), &
       (/ 2, n_o3fields, 2 /) )

  ! ----------------------------------------------
  ! (6) Output for the Reference Sector correction
  ! ----------------------------------------------
  INTEGER (KIND=i4), PARAMETER :: n_rs_fields = 2
  CHARACTER (LEN=42), DIMENSION (2,n_rs_fields), PARAMETER ::  &
       rs_field_names = RESHAPE ( (/ &
       "ReferenceSectorCorrectedVerticalColumn    ", "Reference Sector Corrected Vertical Column", &
       "ReferenceSectorCorrectedUncertainty       ", "Reference Sector Corrected Uncertainty    " /),  &
       (/ 2, n_rs_fields /) )
  CHARACTER (LEN=14), DIMENSION (4,n_rs_fields), PARAMETER ::  &
       rs_field_specs = RESHAPE ( (/ &
       "molec/cm2     ", "nXtrack,nTimes", "OMI-Specific  ","r8            ",     &
       "molec/cm2     ", "nXtrack,nTimes", "OMI-Specific  ","r8            "  /), &
       (/ 4, n_rs_fields /) )
  REAL (KIND=r8), DIMENSION ( 2, n_rs_fields ), PARAMETER :: &
       rs_valids = RESHAPE ( (/                              &
       valid_min_r8,         valid_max_r8,                   &  ! Reference Sector Corrected Vertical Column
       valid_min_r8,         valid_max_r8 /),                &  ! Reference Sector Corrected Uncertainty
       (/2, n_rs_fields/) )

  ! ------------------------------------------------------------------------
  ! (7) Output for the Scattering Weights, Gas Profile and Averaging Kernels
  !     Also albedo from Kleipool or any other OMI climatology.
  ! ------------------------------------------------------------------------
  INTEGER (KIND=i4), PARAMETER :: n_sw_fields = 4
  CHARACTER (LEN=20), DIMENSION (2,n_sw_fields), PARAMETER ::  &
       sw_field_names = RESHAPE ( (/ &
       "ScatteringWeights   ", "Scattering Weights  ",   &
       "SurfacePressure     ", "Surface Pressure    ",   &
       "GasProfile          ", "Gas Profile         ",   &
       "Albedo              ", "Albedo              "/), &
       (/ 2, n_sw_fields /) )
  CHARACTER (LEN=22), DIMENSION (4,n_sw_fields), PARAMETER ::  &
       sw_field_specs = RESHAPE ( (/ &
       "NoUnits               ", "nXtrack,nTimes,nLevels", "OMI-Specific          ","r8                    ",   &
       "hPa                   ", "nXtrack,nTimes        ", "OMI-Specific          ","r8                    ",   &
       "molecules cm-2        ", "nXtrack,nTimes,nLevels", "OMI-Specific          ","r8                    ",   &
       "NoUnits               ", "nXtrack,nTimes        ", "OMI-Specific          ","r8                    "/), &
       (/ 4, n_sw_fields /) )
  REAL (KIND=r8), DIMENSION ( 2, n_sw_fields ), PARAMETER :: &
       sw_valids = RESHAPE ( (/                              &
       valid_min_r8,         valid_max_r8,                   &  ! Scattering Weights
       valid_min_r8,         valid_max_r8,                   &  ! Gas Profile
       valid_min_r8,         valid_max_r8,                   &  ! Surface Pressure (hPa)
       valid_min_r8,         valid_max_r8/),                 &  ! Albedo
       (/2, n_sw_fields/) )

  ! ------------------------------------------------------------------
  ! Integer variables for writing to swath data and geolocation fields
  ! ------------------------------------------------------------------
  INTEGER (KIND=C_LONG)                :: he5_start_1d, he5_stride_1d, he5_edge_1d
  INTEGER (KIND=C_LONG), DIMENSION (2) :: he5_start_2d, he5_stride_2d, he5_edge_2d
  INTEGER (KIND=C_LONG), DIMENSION (3) :: he5_start_3d, he5_stride_3d, he5_edge_3d
  INTEGER (KIND=C_LONG), DIMENSION (4) :: he5_start_4d, he5_stride_4d, he5_edge_4d
  INTEGER (KIND=C_LONG), DIMENSION (5) :: he5_start_5d, he5_stride_5d, he5_edge_5d
  INTEGER (KIND=C_LONG), DIMENSION (6) :: he5_start_6d, he5_stride_6d, he5_edge_6d
  INTEGER (KIND=C_LONG), DIMENSION (7) :: he5_start_7d, he5_stride_7d, he5_edge_7d

  ! -----------------------------------
  ! The Vertical Coordinate of the PGEs
  ! -----------------------------------
  ! Since we are doing nadir, this is either "Slant Column" or "Total Column"
  ! -------------------------------------------------------------------------
  CHARACTER (LEN=12), DIMENSION (sao_pge_min_idx:sao_pge_max_idx), PARAMETER :: &
       vertical_coordinate = (/                                                 &
       "Slant Column", &  ! OClO
       "Total Column", &  ! BrO
       "Total Column", &  ! HCHO
       "Slant Column", &  ! O3
       "Slant Column", &  ! NO2
       "Slant Column", &  ! SO2
       "Total Column", &  ! CHO-CHO
       "Slant Column", &  ! IO
       "Total Column", &  ! H2O
       "Slant Column", &  ! HONO
       "Slant Column", &  ! O2O2
       "Slant Column", &  ! LqH2O
       "Slant Column"  /) ! NO2(D)

  ! -------------------------------
  ! Base names for L2 output swaths
  ! ------------------------------------------------------------------
  ! These Base Name are appended with the PGE target molecules during
  ! the initialization of the HE5 output swath name. They will be
  ! accessed as SWATH_BASE_NAME(pge_idx), and so have to correspond to
  ! the order of PGE indices defined in OMSAO_indices_module:
  !
  !        [1] OClO  [2] BrO  [3] HCHO  [4] O3
  !
  ! The "unofficial" ones are
  !
  !        [5] NO2   [6] SO2  [7] C2H2O2 (Glyoxal)  [8] IO  [9] NO2
  !
  ! Note that these strings will be used IF AND ONLY IF we cannot find
  ! the Swath Name in the PCF file.
  ! ------------------------------------------------------------------
  CHARACTER (LEN=23), DIMENSION (sao_pge_min_idx:sao_pge_max_idx), PARAMETER :: &
       swath_base_name = (/ &
       "OMI Slant Column Amount", &  ! OClO
       "OMI Total Column Amount", &  ! BrO
       "OMI Total Column Amount", &  ! HCHO
       "OMI Slant Column Amount", &  ! O3
       "OMI Slant Column Amount", &  ! NO2
       "OMI Slant Column Amount", &  ! SO2
       "OMI Total Column Amount", &  ! CHO-CHO
       "OMI Slant Column Amount", &  ! IO
       "OMI Total Column Amount", &  ! H2O
       "OMI Slant Column Amount", &  ! HONO
       "OMI Slant Column Amount", &  ! O2O2
       "OMI Slant Column Amount", &  ! LqH2O
       "OMI Slant Column Amount"  /) ! NO2(D)

  ! -------------------------
  ! PGE HDF Global Attributes
  ! ---------------------------------------------------------------
  ! NOTE: These values MIGHT ventually become PSAs, because we want
  !       to search for them in the data set. For now we keep them
  !       as Global Attributes, since this is a much more painless
  !       state than any newly defined PSA.
  ! ---------------------------------------------------------------
  INTEGER (KIND=i4) ::                                &
       NrofScanLines                   = i4_missval,  &
       NrofCrossTrackPixels            = i4_missval,  &
       NrofInputSamples                = i4_missval,  &
       NrofGoodInputSamples            = i4_missval,  &
       NrofGoodOutputSamples           = i4_missval,  &
       NrofMissingSamples              = i4_missval,  &
       NrofSuspectOutputSamples        = i4_missval,  &
       NrofBadOutputSamples            = i4_missval,  &
       NrofConvergedSamples            = i4_missval,  &
       NrofFailedConvergenceSamples    = i4_missval,  &
       NrofExceededIterationsSamples   = i4_missval,  &
       NrofOutofBoundsSamples          = i4_missval
  REAL    (KIND=r4) ::                                &
       PercentGoodOutputSamples        = r4_missval,  &
       PercentSuspectOutputSamples     = r4_missval,  &
       PercentBadOutputSamples         = r4_missval,  &
       AbsolutePercentMissingSamples   = r4_missval

  ! --------------------------------------------
  ! Variables for InputPointer and InputVersions
  ! --------------------------------------------
  INTEGER   (KIND=i4), PARAMETER                 :: n_lun_inp_max = 20
  INTEGER   (KIND=i4), DIMENSION (n_lun_inp_max) :: lun_input
  INTEGER   (KIND=i4)                            :: n_lun_inp
  CHARACTER (LEN=maxchlen)                       :: input_versions

  ! ---------------------------------------------------------------
  ! Finally some system definitions that come with the HE5 Library.
  ! We include this here so that we don't have to worry about it
  ! inside the subroutines that use it.
  ! ---------------------------------------------------------------
  INCLUDE 'hdfeos5.inc'
  INTEGER (KIND = i4), EXTERNAL :: &
       he5_ehrdglatt,  he5_ehwrglatt,  he5_swattach,  he5_swclose,    he5_swcreate,  &
       he5_swdefdfld,  he5_swdefdim,   he5_swdefgfld, he5_swdetach,   he5_swopen,    &
       he5_swrdattr,   he5_swrdfld,    he5_swrdgattr, he5_swrdlattr,  he5_swwrattr,  &
       he5_swwrfld,    he5_swwrgattr,  he5_swwrlattr, HE5_SWfldinfo,                 &
       HE5_SWdefcomp,  HE5_SWdefchunk, HE5_SWsetfill, HE5_SWdefcomch,  HE5_GDOPEN,   &
       HE5_GDATTACH,   HE5_GDRDFLD,    HE5_GDCLOSE,   HE5_GDINQFLDS,   HE5_GDDETACH, &
       HE5_GDINQLATTRS,HE5_GDRDLATTR,  HE5_SWinqdflds

  INTEGER (KIND=C_LONG), EXTERNAL :: HE5_SWinqswath, HE5_SWinqdims

  ! ---------------------------------------------------------------------------
  ! Parameters for HE5 compression. From the limited experimentation performed,
  ! this combination has shown to produce the smallest file sizes for SAO PGEs.
  ! ---------------------------------------------------------------------------
  INTEGER (KIND=i4), PARAMETER :: &
       he5_comp_type   = HE5_HDFE_COMP_SHUF_DEFLATE, &
       he5_comp_par    = 9,                          &
       he5_nocomp_type = HE5_HDFE_COMP_NONE,         &
       he5_nocomp_par  = 0

CONTAINS

  SUBROUTINE he5_init_input_file ( &
       file_name, swath_name, swath_id, swath_file_id, ntimes_aux, nxtrack_aux, he5stat )

    !------------------------------------------------------------------------------
    ! This subroutine initializes the HE5 input files for reading
    ! prefitted BrO and O3 that are used in OMHCHO
    !
    ! Input:
    !   file_name         - Name of HE5 input file
    !
    ! Output:
    !   swath_name.............Name of existing swath in file
    !   swath_file_id_inp......id number for HE5 input file (required for closing it)
    !   swath_id_inp...........id number for swath (required for reading from swath)
    !   ntimes_aux.............nTimes  as given in product file
    !   nxtrack_aux............nXtrack as given in product file
    !   he5stat................OMI_E_SUCCESS if everything went well
    !
    ! No Swath ID Variables passed through MODULE.
    !
    !------------------------------------------------------------------------------

    USE OMSAO_indices_module,    ONLY: pge_hcho_idx, pge_bro_idx, max_calfit_idx
    USE OMSAO_parameters_module, ONLY: i4_missval, r4_missval, r8_missval
    USE OMSAO_errstat_module

    IMPLICIT NONE

    ! ------------------------------
    ! Name of this module/subroutine
    ! ------------------------------
    CHARACTER (LEN=19), PARAMETER :: modulename = 'he5_init_input_file'

    ! ---------------
    ! Input variables
    ! ---------------
    CHARACTER (LEN=*), INTENT (IN) :: file_name

    ! ----------------
    ! Output variables
    ! ----------------
    INTEGER   (KIND=i4),      INTENT (INOUT) :: he5stat
    INTEGER   (KIND=i4),      INTENT (OUT)   :: swath_id, swath_file_id, nxtrack_aux, ntimes_aux
    CHARACTER (LEN=maxchlen), INTENT (OUT)   :: swath_name

    ! ---------------
    ! Local variables
    ! ---------------
    INTEGER   (KIND=i4)                       :: nsep, ndim
    INTEGER   (KIND=i4)                       :: i, errstat, swlen, iend, istart
    INTEGER   (KIND=C_LONG)                   :: ndimcl, errstatcl
    INTEGER   (KIND=i4),      DIMENSION(0:12) :: dim_array, dim_seps
    INTEGER   (KIND=C_LONG),  DIMENSION(0:12) :: dim_arraycl
    CHARACTER (LEN=maxchlen)                  :: dim_chars

    errstat = pge_errstat_ok

    ! -----------------------------------------------------------
    ! Open HE5 output file and check SWATH_FILE_ID ( -1 if error)
    ! -----------------------------------------------------------
    swath_file_id = HE5_SWopen ( TRIM(ADJUSTL(file_name)), he5f_acc_rdonly )
    IF ( swath_file_id == he5_stat_fail ) THEN
       CALL error_check ( &
            0, 1, pge_errstat_error, OMSAO_E_HE5SWOPEN, modulename, vb_lev_default, he5stat )
       IF ( he5stat >= pge_errstat_error ) RETURN
    END IF

    ! ---------------------------------------------
    ! Check for existing HE5 swath and attach to it
    ! ---------------------------------------------
    errstatcl = HE5_SWinqswath  ( TRIM(ADJUSTL(file_name)), swath_name, swlen )
    swath_id = HE5_SWattach ( swath_file_id, TRIM(ADJUSTL(swath_name)) )
    IF ( swath_id == he5_stat_fail ) THEN
       CALL error_check ( &
            0, 1, pge_errstat_error, OMSAO_E_HE5SWATTACH, modulename, vb_lev_default, he5stat )
       IF ( he5stat >= pge_errstat_error ) RETURN
    END IF

    ! ------------------------------
    ! Inquire about swath dimensions
    ! ------------------------------
    ndimcl = HE5_SWinqdims  ( swath_id, dim_chars, dim_arraycl(0:12) )
    ndim   = INT ( ndimcl, KIND=i4 )
    IF ( ndim <= 0 ) THEN
       he5stat = MAX ( he5stat, pge_errstat_error )
       RETURN
    END IF
    dim_array(0:12) = INT ( dim_arraycl(0:12), KIND=i4 )

    ! -----------------------------------------
    ! Extract nTimes and nXtrack from the swath
    ! -----------------------------------------
    nxtrack_aux = 0  ;  ntimes_aux = 0
    dim_chars = TRIM(ADJUSTL(dim_chars))
    swlen = LEN_TRIM(ADJUSTL(dim_chars))
    istart = 1  ;  iend = 1

    ! ----------------------------------------------------------------------
    ! Find the positions of separators (commas, ",") between the dimensions.
    ! Add a "pseudo separator" at the end to fully automate the consecutive
    ! check for nTimes and nXtrack.
    ! ----------------------------------------------------------------------
    nsep = 0 ; dim_seps = 0 ; dim_seps(0) = 0
    getseps: DO i = 1, swlen
       IF ( dim_chars(i:i) == ',' ) THEN
          nsep = nsep + 1
          dim_seps(nsep) = i
       END IF
    END DO getseps
    nsep = nsep + 1 ; dim_seps(nsep) = swlen+1

    ! --------------------------------------------------------------------
    ! Hangle along the NSEP indices until we have found the two dimensions
    ! we are interested in.
    ! --------------------------------------------------------------------
    getdims:DO i = 0, nsep-1
       istart = dim_seps(i)+1 ; iend = dim_seps(i+1)-1
       IF  ( dim_chars(istart:iend) == "nTimes"  ) ntimes_aux  = dim_array(i)
       IF  ( dim_chars(istart:iend) == "nXtrack" ) nxtrack_aux = dim_array(i)
       IF ( ntimes_aux > 0 .AND. nxtrack_aux > 0 ) EXIT getdims
    END DO getdims

    RETURN
  END SUBROUTINE he5_init_input_file

END MODULE OMSAO_he5_module


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

      SUBROUTINE WEDGE (MXND, MLN, NUID, LXK, KXL, NXL, LXN, XN, YN,
     &   LNODES, BNSIZE, IAVAIL, NAVAIL, LLL, KKK, NNN, LLLOLD, NNNOLD,
     &   N1, N6, NLOOP, PWEDGE, GRAPH, VIDEO, NOROOM, ERR)
C***********************************************************************

C  SUBROUTINE WEDGE = EXPANDS TWO SIDE LINES INTO A CORNER NODE
C                      THIS IS REFERRED TO AS A WEDGE.

C***********************************************************************

      DIMENSION NUID (MXND), XN (MXND), YN (MXND)
      DIMENSION LXK (4, MXND), KXL (2, 3*MXND)
      DIMENSION NXL (2, 3*MXND), LXN (4, MXND)
      DIMENSION LNODES (MLN, MXND), BNSIZE (2, MXND)
      DIMENSION L1LIST(20)

      LOGICAL GRAPH, ERR, NOROOM, PWEDGE, VIDEO, TWOLIN

      ERR = .FALSE.
      NNNOLD = MIN (NNN, NNNOLD)
      IF (LXN (3, N1) .EQ. 0) THEN
         TWOLIN = .TRUE.
      ELSE
         TWOLIN = .FALSE.
      ENDIF

C  GET ALL THE DEFINITIONS IN ORDER

      l3 = 0
      N0 = LNODES (2, N1)
      N2 = LNODES (3, N1)
      L1 = LNODES (5, N0)
      L2 = LNODES (5, N1)
      KL1 = KXL (1, L1)

C  FIND L3, N4, AND KL3

      IF (.NOT. TWOLIN) THEN
         DO 100 I = 1, 4
            LTEST = LXK (I, KL1)
            IF (LTEST .NE. L1) THEN
               IF (NXL (1, LTEST) .EQ. N1) THEN
                  L3 = LTEST
                  N4 = NXL (2, LTEST)
                  GOTO 110
               ELSEIF (NXL (2, LTEST) .EQ. N1) THEN
                  L3 = LTEST
                  N4 = NXL (1, LTEST)
                  GOTO 110
               ENDIF
            ENDIF
  100    CONTINUE
         CALL MESSAGE('** PROBLEMS IN WEDGE FINDING L3 AND N4 **')
         ERR = .TRUE.
         GOTO 200
  110    CONTINUE

C  FIND THE ELEMENT KL3 - THE ELEMENT ON THE OTHER SIDE OF L3

         IF (KXL (1, L3) .EQ. KL1) THEN
            KL3 = KXL (2, L3)
         ELSEIF (KXL (2, L3) .EQ. KL1) THEN
            KL3 = KXL (1, L3)
         ELSE
            CALL MESSAGE('** PROBLEMS IN WEDGE FINDING KL3 **')
            ERR = .TRUE.
            GOTO 200
         ENDIF
      ENDIF

C  GET ALL THE N1 LINES

      CALL GETLXN (MXND, LXN, N1, L1LIST, NL, ERR)
      IF (ERR) THEN
         CALL MESSAGE('** PROBLEMS IN WEDGE GETTING N1 LINES **')
         GOTO 200
      ENDIF

C  ERASE THE LINES

      IF ((GRAPH) .OR. (VIDEO)) THEN
         CALL LCOLOR ('BLACK')
         DO 120 I = 1, NL
            NODE1 = NXL (1, L1LIST (I))
            NODE2 = NXL (2, L1LIST (I))
            CALL D2NODE (MXND, XN, YN, NODE1, NODE2)
  120    CONTINUE
         IF (GRAPH) THEN
            CALL LCOLOR ('WHITE')
         ELSE
            CALL LCOLOR ('YELOW')
         ENDIF
         CALL SFLUSH
      ENDIF

C  NOW THAT ALL THE NECESSARY VARIABLES HAVE BEEN DEFINED,
C  START BY DEFINING THE LOCATION OF ALL THE NEW NODES

      NNN = NNN + 2
      IF (NNN .GT. MXND) THEN
         NOROOM = .TRUE.
         GOTO 200
      ENDIF
      N5 = NNN - 1
      N6 = NNN
      IF (PWEDGE) THEN
         XN (N5) = XN (N1)
         YN (N5) = YN (N1)
         XN (N1) = XN (N0) + ( (XN (N5) - XN (N0)) * .33333 )
         YN (N1) = YN (N0) + ( (YN (N5) - YN (N0)) * .33333 )
         XN (N6) = XN (N0) + ( (XN (N5) - XN (N0)) * .66667 )
         YN (N6) = YN (N0) + ( (YN (N5) - YN (N0)) * .66667 )
      ELSE
         XN (N6) = XN (N0) + XN (N2) - XN (N4)
         YN (N6) = YN (N0) + YN (N2) - YN (N4)
         XN (N5) = ( (XN (N1) + ( ( XN (N2) - XN (N1) ) / 3. ) ) +
     &      ((XN (N6) + XN (N2)) * .5) ) * .5
         YN (N5) = ( (YN (N1) + ( ( YN (N2) - YN (N1) ) / 3. ) ) +
     &      ((YN (N6) + YN (N2)) * .5) ) * .5
         XN (N1) = ( (XN (N0) + ( ( XN (N1) - XN (N0) ) * .666667 ) ) +
     &      ((XN (N6) + XN (N0)) * .5) ) * .5
         YN (N1) = ( (YN (N0) + ( ( YN (N1) - YN (N0) ) * .666667 ) ) +
     &      ((YN (N6) + YN (N0)) * .5) ) * .5
      ENDIF

C  NOW ADD LINES L4, L5, AND L6

      LLL = LLL + 3
      L4 = LLL - 2
      IF (TWOLIN) THEN
         NXL (1, L4) = N1
         NXL (2, L4) = N2
      ELSE
         NXL (1, L4) = N4
         NXL (2, L4) = N5
      ENDIF
      L5 = LLL - 1
      L6 = LLL
      NXL (1, L5) = N1
      NXL (2, L5) = N6
      NXL (1, L6) = N5
      NXL (2, L6) = N6

C  NOW UPDATE THE LXN ARRAYS

      DO 130 I = 1, 4
         LXN (I, N5) = 0
         LXN (I, N6) = 0
  130 CONTINUE

      CALL FIXLXN (MXND, LXN, NXL, NUID, NAVAIL, IAVAIL, NNN, LLL,
     &   NNNOLD, LLLOLD, NOROOM, ERR)
      LLLOLD = LLL
      NNNOLD = NNN
      IF ((NOROOM) .OR. (ERR)) GOTO 200

C  UPDATE EXISTING NODES AND THEIR LXN ARRAYS
C  - FIRST MAKE SURE THAT N5 TAKES N1'S BOUNDARY STATUS IF PWEDGE IS ON

      IF ((PWEDGE) .AND. (LXN (2, N1) .LT. 0))
     &   LXN (2, N5) = - IABS (LXN (2, N5))

C  MAKE SURE THAT ALL THE LINES THAT WERE ATTACHED TO N1
C  EXCLUDING L1, L3, (STILL HOOKED TO N1) L4 AND L6 (ALREADY
C  HOOKED TO N5) ARE NOW ATTACHED TO N5 AND HAVE N5 AS THE
C  CORRECT ENDPOINT

      DO 140 I = 1, NL
         LL = L1LIST (I)
         IF ((LL .NE. L1) .AND. (LL .NE. L3) .AND. (LL .NE. L4) .AND.
     &      (LL .NE. L6)) THEN

            CALL DELLXN (MXND, LXN, NUID, NAVAIL, IAVAIL, N1,
     &         LL, NNN, ERR, NOROOM)
            IF ((NOROOM) .OR. (ERR)) THEN
               CALL MESSAGE('** PROBLEMS IN WEDGE UNHOOKING LL FROM '//
     &            'N1 **')
               GOTO 200
            ENDIF

            CALL ADDLXN (MXND, LXN, NUID, NAVAIL, IAVAIL,
     &         N5, LL, NNN, ERR, NOROOM)
            IF ((NOROOM) .OR. (ERR)) THEN
               CALL MESSAGE('** PROBLEMS IN WEDGE HOOKING LL TO N5 **')
               GOTO 200
            ENDIF

            IF (NXL (1, LL) .EQ. N1) THEN
               NXL (1, LL) = N5
            ELSEIF (NXL (2, LL) .EQ. N1) THEN
               NXL (2, LL) = N5
            ELSE
               CALL MESSAGE('** PROBLEMS IN WEDGE CHANGING LL '//
     &            'ENDPOINT FROM N1 TO N5 **')
               ERR = .TRUE.
               GOTO 200
            ENDIF

         ENDIF
  140 CONTINUE

C  NOW ADD THE NEW ELEMENT

      KKK = KKK + 1
      IF (TWOLIN) THEN
         LXK (1, KKK) = L4
         LXK (2, KKK) = L2
      ELSE
         LXK (1, KKK) = L3
         LXK (2, KKK) = L4
      ENDIF
      LXK (3, KKK) = L6
      LXK (4, KKK) = L5

C  NOW FIX THE KXL ARRAY FOR LINE L3

      IF (.NOT. TWOLIN) THEN
         IF (KXL (1, L3) .EQ. KL3) THEN
            KXL (1, L3) = KKK
         ELSEIF (KXL (2, L3) .EQ. KL3) THEN
            KXL (2, L3) = KKK
         ELSE
            CALL MESSAGE('** PROBLEMS IN WEDGE REPLACING KL3 FOR L3 **')
            ERR = .TRUE.
            GOTO 200
         ENDIF
      ENDIF

C  ADD THE KXL ENTRIES FOR THE NEW LINES

      IF (TWOLIN) THEN
         KXL (1, L4) = KL1
         KXL (2, L4) = KKK
         KXL (1, L2) = KKK
      ELSE
         KXL (1, L4) = KKK
         KXL (2, L4) = KL3
      ENDIF
      KXL (1, L5) = KKK
      KXL (1, L6) = KKK

C  NOW FIX THE LXK ARRAY FOR THE ELEMENT KL1 IF TWOLIN

      IF (TWOLIN) THEN
         DO 150 I = 1, 4
            IF (LXK (I, KL1) .EQ. L2) THEN
               LXK (I, KL1) = L4
               GOTO 160
            ENDIF
  150    CONTINUE
         CALL MESSAGE('** PROBLEMS IN WEDGE REPLACING L2 WITH L4 IN '//
     &      'KL1 **')
         ERR = .TRUE.
         GOTO 200
  160    CONTINUE

C  OTHERWISE FIX THE LXK ARRAY FOR THE ELEMENT KL3

      ELSE
         DO 170 I = 1, 4
            IF (LXK (I, KL3) .EQ. L3) THEN
               LXK (I, KL3) = L4
               GOTO 180
            ENDIF
  170    CONTINUE
         CALL MESSAGE('** PROBLEMS IN WEDGE REPLACING L3 WITH L4 IN '//
     &      'KL3 **')
         ERR = .TRUE.
         GOTO 200
  180    CONTINUE
      ENDIF

C  NOW FIX THE LNODES ARRAY

      LNODES (1, N5) = 0
      LNODES (1, N6) = 0

      LNODES (2, N6) = N1
      LNODES (2, N5) = N6
      LNODES (2, N2) = N5

      LNODES (3, N1) = N6
      LNODES (3, N6) = N5
      LNODES (3, N5) = N2

      LNODES (4, N5) = - 1
      LNODES (4, N6) = - 1

      LNODES (5, N1) = L5
      LNODES (5, N6) = L6
      LNODES (5, N5) = L2

      LNODES (8, N5) = LNODES (8, N1)
      LNODES (8, N6) = LNODES (8, N1)

C  PUT THE BEGINNING BOUNDARY DISTANCE IN PLACE

      BNSIZE (1, N5) = BNSIZE (1, N1)
      BNSIZE (1, N6) = BNSIZE (1, N1)
      IF (BNSIZE (1, N1) .GT. 0.) THEN
         SIZMIN = AMIN1 (BNSIZE (1, N1) * BNSIZE (2, N1),
     &      BNSIZE (1, N0) * BNSIZE (2, N0),
     &      BNSIZE (1, N2) * BNSIZE (2, N2)) / BNSIZE (1, N1)
      ELSE
         SIZMIN = AMIN1 (BNSIZE (1, N1) * BNSIZE (2, N1),
     &      BNSIZE (1, N0) * BNSIZE (2, N0),
     &      BNSIZE (1, N2) * BNSIZE (2, N2)) /
     &      SQRT ( (XN (N1) - XN (N2)) ** 2 + (YN (N1) - YN (N2)) ** 2 )
      ENDIF
      IF (PWEDGE) THEN
         BNSIZE (2, N6) = SIZMIN
         BNSIZE (2, N5) = SIZMIN
         BNSIZE (2, N1) = SIZMIN
      ELSE
         BNSIZE (2, N5) = BNSIZE (2, N1) * 1.15
         BNSIZE (2, N6) = BNSIZE (2, N1)
         BNSIZE (2, N1) = BNSIZE (2, N1) * 1.15
      ENDIF

      NLOOP = NLOOP + 2
      ERR = .FALSE.

C  NOW REDRAW THE LINES

      IF ((GRAPH) .OR. (VIDEO)) THEN
         DO 190 I = 1, NL
            IF ((L1LIST (I) .NE. L1) .AND. (L1LIST (I) .NE. L3) .AND.
     &         (L1LIST (I) .NE. L2)) THEN
               NODE1 = NXL (1, L1LIST (I))
               NODE2 = NXL (2, L1LIST (I))
               CALL D2NODE (MXND, XN, YN, NODE1, NODE2)
            ENDIF
  190    CONTINUE
         CALL D2NODE (MXND, XN, YN, N0, N1)
         CALL D2NODE (MXND, XN, YN, N1, N6)
         CALL D2NODE (MXND, XN, YN, N2, N5)
         CALL D2NODE (MXND, XN, YN, N6, N5)
         IF (TWOLIN) THEN
            CALL D2NODE (MXND, XN, YN, N1, N2)
         ELSE
            CALL D2NODE (MXND, XN, YN, N1, N4)
            CALL D2NODE (MXND, XN, YN, N4, N5)
         ENDIF
         CALL SFLUSH
      ENDIF

  200 CONTINUE

      RETURN

      END

ext: f

max_stars_repo_name: jschueller/seacas

max_issues_repo_name: jschueller/seacas

max_forks_repo_name: jschueller/seacas


text:
      SUBROUTINE SETFIL (FILT, FLN, FLISX,FLIS, FLESX,FLES)

C  SETFIL translates the character version of a filter list into the
C  appropriate integer arrays.

      INTEGER     FLN, FLISX(*),FLIS(*), FLESX(*),FLES(*)

C  Declaration of COLLEN and WORK allows for a filter list with 55
C  filters, each with an inclusion set and exclusion set of up to 20
C  members.  Generated test case from P07 uses at most 50 filters.
      INTEGER     NUMCOL, COLLEN(110), WORK(20,110)
      INTEGER     ITOT,ETOT, FLTDX,ELDX, ICOL,ECOL

      CHARACTER   FILT*(*)

      CALL SET2D (FILT, 20, NUMCOL, COLLEN, WORK)
      FLN = NUMCOL/2
      IF (FLN*2 .NE. NUMCOL) THEN
         CALL UNMSG ('Illegal filter list passed to SETFIL.')
      ENDIF

      ITOT = 0
      ETOT = 0
      DO 100 FLTDX = 1,FLN
         ICOL = 2*FLTDX - 1
         ECOL = 2*FLTDX

C  inclusion set
         DO 200 ELDX = 1,COLLEN(ICOL)
            ITOT = ITOT+1
            FLIS(ITOT) = WORK(ELDX, ICOL)
200      CONTINUE
         FLISX(FLTDX) = ITOT

C  exclusion set
         DO 300 ELDX = 1,COLLEN(ECOL)
            ETOT = ETOT+1
            FLES(ETOT) = WORK(ELDX, ECOL)
300      CONTINUE
         FLESX(FLTDX) = ETOT
100   CONTINUE

      END


text:
C     ( Last modified on 23 Dec 2000 at 22:01:38 )
      SUBROUTINE UPROD( N, GOTH, X, P, RESULT )
      INTEGER           N
      LOGICAL           GOTH
CS    REAL              X( N ), P( N ), RESULT( N )
CD    DOUBLE PRECISION  X( N ), P( N ), RESULT( N )
C
C  Compute the matrix-vector product between the Hessian matrix
C  of a group partially separable function and a given vector P.
C  The result is placed in RESULT. If GOTH is .TRUE. the second
C  derivatives are assumed to have already been computed. If
C  the user is unsure, set GOTH = .FALSE. the first time a product
C  is required with the Hessian evaluated at X. X is not used if
C  GOTH = .TRUE.
C
C  Based on the minimization subroutine LANCELOT/SBMIN
C  by Conn, Gould and Toint.
C
C  Nick Gould, for CGT productions.
C  July, 1991.
C
      INTEGER            LIWK  , LWK   , LFUVAL, LLOGIC, LCHARA
C
C  ---------------------------------------------------------------------
C
C  Parameters whose value might be changed by the user:
C
C  The following parameters define the sizes of problem
C  dependent arrays. These may be changed by the user to
C  suit a particular problem or system configuration.
C
C  The TOOLS will issue error messages if any of these sizes
C  is too small, telling which parameter to increase.
C
C  ---------------------------------------------------------------------
C
C#{sizing}
C
      INTEGER                IWK( LIWK    )
      LOGICAL              LOGI ( LLOGIC  )
      CHARACTER * 10       CHA  ( LCHARA  )
CS    REAL                   WK ( LWK     )
CD    DOUBLE PRECISION       WK ( LWK     )
CS    REAL              FUVALS  ( LFUVAL  )
CD    DOUBLE PRECISION  FUVALS  ( LFUVAL  )
C
C  ---------------------------------------------------------------------
C
C  End of parameters which might be changed by the user.
C
C  ---------------------------------------------------------------------
C
C  Integer variables from the GLOBAL common block.
C
      INTEGER            NG    , NELNUM, NGEL  , NVARS , NNZA  , NGPVLU
      INTEGER            NEPVLU, NG1   , NEL1  , ISTADG, ISTGP , ISTADA
      INTEGER            ISTAEV, ISTEP , ITYPEG, KNDOFC, ITYPEE
      INTEGER            IELING, IELVAR, ICNA  , ISTADH, INTVAR, IVAR
      INTEGER            ICALCF, ITYPEV, IWRK  , A     , B
      INTEGER            U     , GPVALU, EPVALU
      INTEGER            ESCALE, GSCALE, VSCALE, GVALS , XT    , DGRAD
      INTEGER            Q     , WRK   , INTREP, GXEQX , GNAMES, VNAMES
      INTEGER            LO    , CH    , LIWORK, LWORK , NGNG  , FT
      INTEGER            LA, LB, NOBJGR, LU, LELVAR
      INTEGER            LSTAEV, LSTADH, LNTVAR, LCALCF
      INTEGER            LELING, LINTRE, LFT, LGXEQX, LSTADG, LGVALS
      INTEGER            LICNA , LSTADA, LKNDOF, LGPVLU, LEPVLU
      INTEGER            LGSCAL, LESCAL, LVSCAL, LCALCG
C
C  Integer variables from the LOCAL common block.
C
      INTEGER            LFXI  , LGXI  , LHXI  , LGGFX , LDX   , LGRJAC
      INTEGER            LQGRAD, LBREAK, LP    , LXCP  , LX0   , LGX0
      INTEGER            LDELTX, LBND  , LWKSTR, LSPTRS, LSELTS, LINDEX
      INTEGER            LSWKSP, LSTAGV, LSTAJC, LIUSED, LFREEC
      INTEGER            LNNONZ, LNONZ2, LSYMMD, LSYMMH
      INTEGER            LSLGRP, LSVGRP, LGCOLJ, LVALJR, LSEND
      INTEGER            LNPTRS, LNELTS, LNNDEX, LNWKSP, LNSTGV
      INTEGER            LNSTJC, LNIUSE, LNFREC, LNNNON, LNNNO2, LNSYMD
      INTEGER            LNSYMH, LNLGRP, LNVGRP, LNGCLJ, LNVLJR, LNQGRD
      INTEGER            LNBRAK, LNP   , LNBND , LNFXI , LNGXI , LNGUVL
      INTEGER            LNHXI , LNHUVL, LNGGFX, LNDX  , LNGRJC, LIWK2
      INTEGER            LWK2  , MAXSIN, NINVAR, MAXSEL
      INTEGER            NTYPE , NSETS , LSTYPE, LSSWTR, LSSIWT, LSIWTR
      INTEGER            LSWTRA, LNTYPE, LNSWTR, LNSIWT, LNIWTR
      INTEGER            LNWTRA, LSISET, LSSVSE, LNISET, LNSVSE
      LOGICAL            ALTRIV, FIRSTG
C
C  integer variables from the PRFCTS common block.
C
      INTEGER            NC2OF , NC2OG , NC2OH, NC2CF, NC2CG, NC2CH
      INTEGER            NHVPR , PNC
      REAL               SUTIME, STTIME
      COMMON / GLOBAL /  IWK   , WK    , FUVALS, LOGI  ,
     *                   NG    , NELNUM, NGEL  , NVARS , NNZA  , NGPVLU,
     *                   NEPVLU, NG1   , NEL1  , ISTADG, ISTGP , ISTADA,
     *                   ISTAEV, ISTEP , ITYPEG, KNDOFC, ITYPEE,
     *                   IELING, IELVAR, ICNA  , ISTADH, INTVAR, IVAR  ,
     *                   ICALCF, ITYPEV, IWRK  , A     , B     ,
     *                   U     , GPVALU, EPVALU,
     *                   ESCALE, GSCALE, VSCALE, GVALS , XT    , DGRAD ,
     *                   Q     , WRK   , INTREP, GXEQX , GNAMES, VNAMES,
     *                   LO    , CH    , LIWORK, LWORK , NGNG  , FT    ,
     *                   ALTRIV, FIRSTG,
     *                   LA, LB, NOBJGR, LU, LELVAR,
     *                   LSTAEV, LSTADH, LNTVAR, LCALCF,
     *                   LELING, LINTRE, LFT, LGXEQX, LSTADG, LGVALS,
     *                   LICNA , LSTADA, LKNDOF, LGPVLU, LEPVLU,
     *                   LGSCAL, LESCAL, LVSCAL, LCALCG
      COMMON / CHARA /   CHA
      COMMON / LOCAL /   LFXI  , LGXI  , LHXI  , LGGFX , LDX   , LGRJAC,
     *                   LQGRAD, LBREAK, LP    , LXCP  , LX0   , LGX0  ,
     *                   LDELTX, LBND  , LWKSTR, LSPTRS, LSELTS, LINDEX,
     *                   LSWKSP, LSTAGV, LSTAJC, LIUSED, LFREEC,
     *                   LNNONZ, LNONZ2, LSYMMD, LSYMMH,
     *                   LSLGRP, LSVGRP, LGCOLJ, LVALJR, LSEND ,
     *                   LNPTRS, LNELTS, LNNDEX, LNWKSP, LNSTGV,
     *                   LNSTJC, LNIUSE, LNFREC, LNNNON, LNNNO2, LNSYMD,
     *                   LNSYMH, LNLGRP, LNVGRP, LNGCLJ, LNVLJR, LNQGRD,
     *                   LNBRAK, LNP   , LNBND , LNFXI , LNGXI , LNGUVL,
     *                   LNHXI , LNHUVL, LNGGFX, LNDX  , LNGRJC, LIWK2 ,
     *                   LWK2  , MAXSIN, NINVAR, MAXSEL, NTYPE ,
     *                   NSETS , LSTYPE, LSSWTR, LSSIWT, LSIWTR,
     *                   LSWTRA, LNTYPE, LNSWTR, LNSIWT, LNIWTR,
     *                   LNWTRA, LSISET, LSSVSE, LNISET, LNSVSE
      COMMON / PRFCTS /  NC2OF , NC2OG , NC2OH, NC2CF, NC2CG, NC2CH,
     *                   NHVPR , PNC   , SUTIME, STTIME
      SAVE             / GLOBAL /, / LOCAL /, / CHARA /, / PRFCTS /
C
C  Local variables
C
      INTEGER            I , IG, J , NN, NBPROD, NNONNZ
      INTEGER            LNWK  , LNWKB , LNWKC , LWKB  , LWKC
      INTEGER            IFSTAT, IGSTAT
CS    REAL               ZERO  , ONE   , FTT
CD    DOUBLE PRECISION   ZERO  , ONE   , FTT
CS    PARAMETER        ( ZERO  = 0.0E+0, ONE = 1.0E+0 )
CD    PARAMETER        ( ZERO  = 0.0D+0, ONE = 1.0D+0 )
      EXTERNAL           RANGE
C
C  There are non-trivial group functions.
C
      IF ( .NOT. GOTH ) THEN
         DO 10 I = 1, MAX( NELNUM, NG )
           IWK( ICALCF + I ) = I
   10    CONTINUE
C
C  Evaluate the element function values.
C
         CALL ELFUN ( FUVALS, X, WK( EPVALU + 1 ), NELNUM,
     *                IWK( ITYPEE + 1 ), IWK( ISTAEV + 1 ),
     *                IWK( IELVAR + 1 ), IWK( INTVAR + 1 ),
     *                IWK( ISTADH + 1 ), IWK( ISTEP  + 1 ),
     *                IWK( ICALCF + 1 ),
     *                LINTRE, LSTAEV, LELVAR, LNTVAR, LSTADH,
     *                LNTVAR, LINTRE, LFUVAL, LVSCAL, LEPVLU,
     *                1, IFSTAT )
C
C  Evaluate the element function values.
C
         CALL ELFUN ( FUVALS, X, WK( EPVALU + 1 ), NELNUM,
     *                IWK( ITYPEE + 1 ), IWK( ISTAEV + 1 ),
     *                IWK( IELVAR + 1 ), IWK( INTVAR + 1 ),
     *                IWK( ISTADH + 1 ), IWK( ISTEP  + 1 ),
     *                IWK( ICALCF + 1 ),
     *                LINTRE, LSTAEV, LELVAR, LNTVAR, LSTADH,
     *                LNTVAR, LINTRE, LFUVAL, LVSCAL, LEPVLU,
     *                3, IFSTAT )
C
C  Compute the group argument values ft.
C
         DO 90 IG = 1, NG
            FTT    = - WK( B + IG )
C
C  Include the contribution from the linear element.
C
            DO 30 J = IWK( ISTADA + IG ), IWK( ISTADA + IG + 1 ) - 1
               FTT  = FTT + WK( A + J ) * X( IWK( ICNA + J ) )
   30       CONTINUE
C
C  Include the contributions from the nonlinear elements.
C
            DO 60 J = IWK( ISTADG + IG ), IWK( ISTADG + IG + 1 ) - 1
               FTT  = FTT + WK( ESCALE + J ) * FUVALS( IWK( IELING + J))
   60       CONTINUE
            WK( FT + IG ) = FTT
C
C  Record the derivatives of trivial groups.
C
            IF ( LOGI( GXEQX + IG ) ) THEN
               WK( GVALS +     NG + IG ) = ONE
               WK( GVALS + 2 * NG + IG ) = ZERO
            END IF
   90    CONTINUE
C
C  Evaluate the group derivative values.
C
         IF ( .NOT. ALTRIV ) CALL GROUP ( WK ( GVALS + 1 ), NG,
     *         WK( FT + 1 ), WK ( GPVALU + 1 ), NG,
     *         IWK( ITYPEG + 1 ), IWK( ISTGP + 1 ),
     *         IWK( ICALCF + 1 ),
     *         LCALCG, NG1   , LCALCG, LCALCG, LGPVLU,
     *         .TRUE., IGSTAT )
C
C  Compute the gradient value.
C
CS       CALL SELGRD( N, NG, FIRSTG, IWK( ICNA + 1 ), LICNA,
CD       CALL DELGRD( N, NG, FIRSTG, IWK( ICNA + 1 ), LICNA,
     *                IWK( ISTADA + 1 ), LSTADA, IWK( IELING + 1 ),
     *                LELING, IWK( ISTADG + 1 ), LSTADG,
     *                IWK( ITYPEE + 1 ), LINTRE,
     *                IWK( ISTAEV + 1 ), LSTAEV, IWK( IELVAR + 1 ),
     *                LELVAR, IWK( INTVAR + 1 ), LNTVAR,
     *                IWK( LSVGRP + 1 ), LNVGRP, IWK( LSTAJC + 1 ),
     *                LNSTJC, IWK( LSTAGV + 1 ), LNSTGV,
     *                WK( A + 1 ), LA, WK( GVALS + NG + 1 ), LGVALS,
C ** from LGGFX to LNGUVL to stop zero length arrays on VAX.
     *                FUVALS, LNGUVL, FUVALS( LGGFX + 1 ),
     *                WK( GSCALE + 1 ), LGSCAL,
     *                WK( ESCALE + 1 ), LESCAL, FUVALS( LGRJAC + 1 ),
     *                LNGRJC, WK( WRK + 1 ), WK( WRK + N + 1 ),
     *                MAXSEL, LOGI( GXEQX + 1 ), LGXEQX,
     *                LOGI( INTREP + 1 ), LINTRE, RANGE  )
         FIRSTG = .FALSE.
      END IF
C
C  Ensure that the product involves all components of P.
C
      DO 100 I             = 1, N
         IWK( IVAR   + I ) = I
         IWK( LNNONZ + I ) = I
  100 CONTINUE
C
C  Initialize RESULT as the zero vector.
C
CS    CALL SSETVL( N, RESULT, 1, ZERO )
CD    CALL DSETVL( N, RESULT, 1, ZERO )
C
C  Define the real work space needed for HSPRD.
C  Ensure that there is sufficient space.
C
      NN    = NINVAR + N
      LNWK  = MAX( NG, MAXSEL )
      LNWKB = MAXSIN
      LNWKC = MAXSIN
      LWKB  = LNWK
      LWKC  = LWKB + LNWKB
C
C  Evaluate the product.
C
CS    CALL SHSPRD( N, NN, NG, NGEL, N, 1, N, NBPROD, NELNUM .EQ. 0,
CD    CALL DHSPRD( N, NN, NG, NGEL, N, 1, N, NBPROD, NELNUM .EQ. 0,
     *    IWK( IVAR   + 1 ), IWK( ISTAEV + 1 ), LSTAEV,
     *    IWK( ISTADH + 1 ), LSTADH, IWK( INTVAR + 1 ),
     *    LNTVAR, IWK( IELING + 1 ), LELING, IWK( IELVAR + 1 ),
     *    LELVAR, IWK( LSTAJC + 1 ), LNSTJC, IWK( LSELTS + 1 ),
     *    LNELTS, IWK( LSPTRS + 1 ), LNPTRS, IWK( LGCOLJ + 1 ),
     *    LNGCLJ, IWK( LSLGRP + 1 ), LNLGRP, IWK( LSWKSP + 1 ),
     *    LNWKSP, IWK( LSVGRP + 1 ), LNVGRP, IWK( LSTAGV + 1 ),
     *    LNSTGV, IWK( LVALJR + 1 ), LNVLJR, IWK( ITYPEE + 1 ),
     *    LINTRE, NNONNZ, IWK( LNNONZ + 1 ), LNNNON,
     *    IWK( LIUSED + 1 ), LNIUSE, IWK( LNONZ2 + 1 ),
     *    LNNNO2, IWK( LSYMMH + 1 ), MAXSIN, P, RESULT,
     *    WK( GVALS + NG + 1 ), WK( GVALS + 2 * NG + 1 ),
     *    FUVALS( LGRJAC + 1 ), LNGRJC, WK( GSCALE + 1 ),
     *    WK( ESCALE + 1 ), LESCAL, FUVALS, LNHUVL,
     *    WK( WRK + 1 ), LNWK, WK( WRK + LWKB + 1 ),
     *    LNWKB, WK( WRK + LWKC + 1 ), LNWKC,
     *    LOGI( GXEQX + 1 ), LGXEQX, LOGI( INTREP + 1 ),
     *    LINTRE, .TRUE., RANGE  )
C
C  Update the counters for the report tool.
C
      NHVPR = NHVPR + 1
      IF ( .NOT. GOTH ) THEN
         NC2OH = NC2OH + 1
      END IF
      RETURN
C
C  end of UPROD.
C
      END

max_forks_repo_name: dynamics-of-stellar-systems/dynamite


text:
subroutine combinations
use fdeclarations

10 format (6f7.3)
open(69, file='amatrix.txt', action='write', status='replace')
write(69,*) e**(w-1)
do col1 = 1,e
do col2 = 1,e
do col3 = 1,e
do col4 = 1,e
write(69,10) rmatrix(col1,1), rmatrix(col2,2), rmatrix(col3,3), rmatrix(col4,4)
end do
end do
end do
end do
close(69, status='keep')

end subroutine combinations

max_stars_repo_name: chtheodoro/Habfuzz

max_issues_repo_name: chtheodoro/habfuzz-plus

max_forks_repo_name: chtheodoro/habfuzz-plus