! vms_time_constants_def.for - vax/vms 64-bit system times - a few reference
! points for time calculations.
!
! Note that absolute times are given as the number of 100-nano-second
! increments since 17-NOV-1858 00:00:00.00.
! Delta times are given as an unsigned 64-bit count (different
! than the vax/vms delta times) of 100-ns increments.
!
	integer*4	msec_per_sec
	integer*4	msec_per_minute
	integer*4	msec_per_hour
	parameter	(msec_per_sec=1000)
	parameter	(msec_per_minute=60*1000)
	parameter	(msec_per_hour=3600*1000)

	byte ui8zero(8)
	byte boy1982(8)
	byte boy1994(8)
	byte ui8year(8)
	byte ui8Lyear(8)
	byte ui8day(8)
	byte ui8hour(8)
	byte ui8min(8)
	byte ui8sec(8)
	byte ui8hsec(8)
	byte ui8msec(8)

	! delta time of a major frame in 2x (46sec) and 1x (92s)
	byte ui8_46s(8)
	byte ui8_92s(8)

	! delta time of a minor frame in 2x (46sec) and 1x (92s)
	byte ui8_d2x(8)
	byte ui8_d1x(8)

	data ui8zero	/'00'x,'00'x,'00'x,'00'x,'00'x,'00'x,'00'x,'00'x/
	data boy1982	/'00'x,'80'x,'79'x,'74'x,'94'x,'09'x,'8a'x,'00'x/
	data boy1994	/'00'x,'c0'x,'07'x,'9d'x,'c1'x,'7d'x,'97'x,'00'x/
	data ui8year	/'00'x,'c0'x,'c6'x,'78'x,'d1'x,'1e'x,'01'x,'00'x/
	data ui8Lyear	/'00'x,'80'x,'30'x,'a3'x,'9a'x,'1f'x,'01'x,'00'x/
	data ui8day	/'00'x,'c0'x,'69'x,'2a'x,'c9'x,'00'x,'00'x,'00'x/
	data ui8hour	/'00'x,'68'x,'c4'x,'61'x,'08'x,'00'x,'00'x,'00'x/
	data ui8min	/'00'x,'46'x,'c3'x,'23'x,'00'x,'00'x,'00'x,'00'x/
	data ui8sec	/'80'x,'96'x,'98'x,'00'x,'00'x,'00'x,'00'x,'00'x/
	data ui8hsec	/'a0'x,'86'x,'01'x,'00'x,'00'x,'00'x,'00'x,'00'x/
	data ui8msec	/'10'x,'27'x,'00'x,'00'x,'00'x,'00'x,'00'x,'00'x/
	data ui8_46s	/'00'x,'0b'x,'6b'x,'1b'x,'00'x,'00'x,'00'x,'00'x/
	data ui8_92s	/'00'x,'16'x,'d6'x,'36'x,'00'x,'00'x,'00'x,'00'x/
	data ui8_d2x	/'80'x,'13'x,'1c'x,'00'x,'00'x,'00'x,'00'x,'00'x/
	data ui8_d1x	/'00'x,'27'x,'38'x,'00'x,'00'x,'00'x,'00'x,'00'x/


! H0 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
! H0 X
! H0 X   libAtoms+QUIP: atomistic simulation library
! H0 X
! H0 X   Portions of this code were written by
! H0 X     Albert Bartok-Partay, Silvia Cereda, Gabor Csanyi, James Kermode,
! H0 X     Ivan Solt, Wojciech Szlachta, Csilla Varnai, Steven Winfield.
! H0 X
! H0 X   Copyright 2006-2010.
! H0 X
! H0 X   These portions of the source code are released under the GNU General
! H0 X   Public License, version 2, http://www.gnu.org/copyleft/gpl.html
! H0 X
! H0 X   If you would like to license the source code under different terms,
! H0 X   please contact Gabor Csanyi, gabor@csanyi.net
! H0 X
! H0 X   Portions of this code were written by Noam Bernstein as part of
! H0 X   his employment for the U.S. Government, and are not subject
! H0 X   to copyright in the USA.
! H0 X
! H0 X
! H0 X   When using this software, please cite the following reference:
! H0 X
! H0 X   http://www.libatoms.org
! H0 X
! H0 X  Additional contributions by
! H0 X    Alessio Comisso, Chiara Gattinoni, and Gianpietro Moras
! H0 X
! H0 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
!X
!X TBModel_NRL_TB_defs module
!X
!% Definitions for NRL-TB model, to be shared with format conversion program
!X
!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
module TBModel_NRL_TB_defs_module
implicit none
public
  integer, parameter :: max_n_orb_sets = 4

  integer, parameter :: ABCD_A = 1, ABCD_B = 2, ABCD_C = 3, ABCD_D = 4
  integer, parameter :: SPDF_S = 1, SPDF_P = 2, SPDF_D = 3, SPDF_F = 4

  integer, parameter :: MC_E = 1, MC_F = 2, MC_FB = 3, MC_G_SQ = 4
end module TBModel_NRL_TB_defs_module


!
!  Copyright (c) 2019 National Technology & Engineering Solutions of
!  Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with
!  NTESS, the U.S. Government retains certain rights in this software.
!
   SUBROUTINE Z91_Z92
     USE NWC_DATABASE
     USE NWC_2000
     IMPLICIT NONE

     !This subroutine contains elements 91-92 (protactinium and uranium)
     !and their naturally occuring isotopes. Protactinium does not
     !occur naturally in nature and is therefore not included in
     !the subroutine.
     !
     !Created with the Current Nuclear Wallet Cards (2004)
     !on June 2, 2004 by Karen Kajder.
     !
     !Modified to latest NWC electronic version values and ENDF/B-VII cross
     !sections by K. Russell DePriest on December 15, 2011.
     !
     ! - ENDF/B-VII Release 1 cross sections (that is, .80c) made the default
     !   on 05/09/2014 by K. Russell DePriest.
     !
     ! - ENDF/B-VIII.0 cross sections at 293.6 K (that is, .00c) made the default
     !   on 07/22/2020 by K. Russell DePriest.
     !
     ! - Nuclear Wallet Card values verified on 07/22/2020 using
     !   "Nuclear Wallet Cards database version of 7/10/2019" on nndc.bnl.gov website.

     !Local variables
     REAL::holder, mass_of_element
     INTEGER:: i

     !Number of Uranium Isotopes
     u_size = 3

     uranium_array(1)%z = 92
     uranium_array(1)%a = 234
     uranium_array(1)%symbol ="U-234 "
     uranium_array(1)%mass_defect = 38.1450
     uranium_array(1)%atom_percent = 0.0054
     uranium_array(1)%zaid = "92234.00c"

     uranium_array(2)%z = 92
     uranium_array(2)%a = 235
     uranium_array(2)%symbol ="U-235 "
     uranium_array(2)%mass_defect = 40.9188
     uranium_array(2)%atom_percent = 0.7204
     uranium_array(2)%zaid = "92235.00c"

     uranium_array(3)%z = 92
     uranium_array(3)%a = 238
     uranium_array(3)%symbol ="U-238 "
     uranium_array(3)%mass_defect = 47.3077
     uranium_array(3)%atom_percent = 99.2742
     uranium_array(3)%zaid = "92238.00c"

     !Calculate isotopic mass for Uranium
     DO i=1, u_size
          holder = uranium_array(i)%a + (uranium_array(i)%mass_defect/MeV_amu)

          uranium_array(i)%isotopic_mass = holder
     END DO

     !Set mass and holder to zero.
     u_mass = 0.0
     holder = 0.0

     !Calculate mass of Uranium
     DO i=1, u_size
          u_mass = holder + (uranium_array(i)%isotopic_mass* &
          &  uranium_array(i)%atom_percent)/100

          holder = u_mass
     END DO

     !Calculate weight percent of Uranium
     DO i=1, u_size
          uranium_array(i)%weight_percent = (uranium_array(i)%isotopic_mass &
          &   * uranium_array(i)%atom_percent)/u_mass
     END DO

   END SUBROUTINE Z91_Z92


      SUBROUTINE DT_SHFAST(Mode,Ppn,Iback)

      IMPLICIT NONE
      INTEGER i , Iback , jbproj , jbtarg , jjproj , jjtarg , jp , jpz ,
     &        jt , jtz , Mode
      DOUBLE PRECISION ONE , pp , Ppn , TINY1 , TINY10 , TWO , ZERO
      SAVE

      INCLUDE 'inc/dtflka'

      PARAMETER (ZERO=0.0D0,TINY10=1.0D-10,TINY1=1.0D-1,ONE=1.0D0,
     &           TWO=2.0D0)

C emulsion treatment
      INCLUDE 'inc/dtcomp'
C Glauber formalism: parameters
      INCLUDE 'inc/dtglam'
C properties of interacting particles
      INCLUDE 'inc/dtprta'
C Glauber formalism: cross sections
      INCLUDE 'inc/dtglxs'

      Iback = 0

      IF ( Mode.EQ.2 ) THEN
         OPEN (47,FILE='outdata0/shmakov.out',STATUS='UNKNOWN')
         WRITE (47,99010) IT , ITZ , IP , IPZ , IJProj , IBProj ,
     &                    IJTarg , IBTarg , Ppn
         WRITE (47,99020) RASh(1) , RBSh(1) , BMAx(1) , BSTep(1)
         WRITE (47,99030) SIGsh , ROSh , GSH
         DO i = 1 , 100
            WRITE (47,'(1X,E15.5)') BSIte(1,1,1,i)
         END DO
         WRITE (47,99040) NSIteb , NSTatb , ECMnn(1) , XSPro(1,1,1) ,
     &                    BSLope
         CLOSE (47)
      ELSE
         OPEN (47,FILE='outdata0/shmakov.out',STATUS='UNKNOWN')
         READ (47,99010) jt , jtz , jp , jpz , jjproj , jbproj ,
     &                   jjtarg , jbtarg , pp
         IF ( (jt.EQ.IT) .AND. (jtz.EQ.ITZ) .AND. (jp.EQ.IP) .AND.
     &        (jpz.EQ.IPZ) .AND. (jjproj.EQ.IJProj) .AND.
     &        (jbproj.EQ.IBProj) .AND. (jjtarg.EQ.IJTarg) .AND.
     &        (jbtarg.EQ.IBTarg) .AND. (ABS(pp-Ppn).LT.(Ppn*0.01D0)) )
     &        THEN
            READ (47,99020) RASh(1) , RBSh(1) , BMAx(1) , BSTep(1)
            READ (47,99030) SIGsh , ROSh , GSH
            DO i = 1 , 100
               READ (47,'(1X,E15.5)') BSIte(1,1,1,i)
            END DO
            READ (47,99040) NSIteb , NSTatb , ECMnn(1) , XSPro(1,1,1) ,
     &                      BSLope
         ELSE
            Iback = 1
         END IF
         CLOSE (47)
      END IF
99010 FORMAT (1X,8I5,E15.5)
99020 FORMAT (1X,4E15.5)
99030 FORMAT (1X,3E15.5)
99040 FORMAT (1X,2I10,3E15.5)

      END SUBROUTINE


! ******************************************************************************************************************************** !
! END SEDGEM
SUBROUTINE end_sedgem( &
     & dum_dts,        &
     & dum_sfcsumocn   &
     & )
  use genie_control
  USE gem_cmn
  USE sedgem_lib
  USE sedgem_data
  USE sedgem_data_netCDF
  USE genie_util, ONLY: check_iostat
  IMPLICIT NONE
  ! ---------------------------------------------------------- !
  ! DEFINE DUMMY ARGUMENTS
  ! ---------------------------------------------------------- !
  REAL,INTENT(in)::dum_dts
  real,DIMENSION(n_ocn,n_i,n_j),intent(in)::dum_sfcsumocn
  ! ---------------------------------------------------------- !
  ! DEFINE LOCAL VARIABLES
  ! ---------------------------------------------------------- !
  real::loc_dtyr ! local time step in years
  real::loc_dts  ! local time step in seconds
  real::loc_yr
  integer::loc_iou
  ! ---------------------------------------------------------- !
  ! INITIALIZE LOCAL VARIABLES
  ! ---------------------------------------------------------- !
  loc_yr = 0.0
  ! ---------------------------------------------------------- !
  ! SHUTDOWN ...
  ! ---------------------------------------------------------- !
  print*,'======================================================='
  print*,' >>> Initialising SEDGEM module shutdown ...'
  ! ------------------------------------------------------- !
  ! SAVE DATA: 2-D netCDF + ASCII output
  ! ------------------------------------------------------- !
  ! calculate sediment model time step length
  loc_dts  = dum_dts
  loc_dtyr = loc_dts/conv_yr_s
  ! save diagnostics
  call sub_data_save_seddiag_GLOBAL(loc_dtyr,dum_sfcsumocn)
  ! save requested sediment cores as ASCII
  if (ctrl_data_save_ascii) call sub_sedgem_save_sedcore()
  ! save final oecan-sediment interface properties
  ! NOTE: netCDF was set up to be able to save multiple time-slices, but is only being used here to save a single final slice
  if (ctrl_data_save_ascii) call sub_data_save_seddiag_2D(loc_dtyr,dum_sfcsumocn)
  call sub_save_netcdf(const_real_zero)
  call sub_save_netcdf_sed2d(loc_dtyr,dum_sfcsumocn)
  call sub_closefile(ntrec_siou)
  ntrec_sout = ntrec_sout + 1
  ! ------------------------------------------------------- !
  ! SAVE DATA: SEDCORES
  ! ------------------------------------------------------- !
  if (nv_sedcore > 0) then
     string_ncsedcorein = TRIM(par_rstdir_name)//trim(par_ncsedcore_name)
     string_ncsedcoreout = TRIM(par_outdir_name)//trim(par_ncsedcore_name)
     ncsedcore_ntrec = 0
     call sub_data_netCDF_sedcoresave(trim(string_ncsedcorein),trim(string_ncsedcoreout),loc_yr,loc_iou)
  end if
  ! ---------------------------------------------------------- !
  ! CLEAN UP
  ! ---------------------------------------------------------- !
  ! ---------------------------------------------------------- ! deallocate arrays
  DEALLOCATE(phys_sed,STAT=dealloc_error)
  call check_iostat(dealloc_error,__LINE__,__FILE__)
  DEALLOCATE(sed_mask,STAT=dealloc_error)
  call check_iostat(dealloc_error,__LINE__,__FILE__)
  DEALLOCATE(sed_mask_reef,STAT=dealloc_error)
  call check_iostat(dealloc_error,__LINE__,__FILE__)
  DEALLOCATE(sed_mask_muds,STAT=dealloc_error)
  call check_iostat(dealloc_error,__LINE__,__FILE__)
  DEALLOCATE(sed_mask_hydr,STAT=dealloc_error)
  call check_iostat(dealloc_error,__LINE__,__FILE__)
  DEALLOCATE(sed,STAT=dealloc_error)
  call check_iostat(dealloc_error,__LINE__,__FILE__)
  DEALLOCATE(sed_top,STAT=dealloc_error)
  call check_iostat(dealloc_error,__LINE__,__FILE__)
  DEALLOCATE(sed_top_h,STAT=dealloc_error)
  call check_iostat(dealloc_error,__LINE__,__FILE__)
  DEALLOCATE(sed_fsed,STAT=dealloc_error)
  call check_iostat(dealloc_error,__LINE__,__FILE__)
  DEALLOCATE(sed_fdis,STAT=dealloc_error)
  call check_iostat(dealloc_error,__LINE__,__FILE__)
  DEALLOCATE(sedocn_fnet,STAT=dealloc_error)
  call check_iostat(dealloc_error,__LINE__,__FILE__)
  DEALLOCATE(sed_carb,STAT=dealloc_error)
  call check_iostat(dealloc_error,__LINE__,__FILE__)
  DEALLOCATE(sed_carbconst,STAT=dealloc_error)
  call check_iostat(dealloc_error,__LINE__,__FILE__)
  DEALLOCATE(sed_carbalk,STAT=dealloc_error)
  call check_iostat(dealloc_error,__LINE__,__FILE__)
  DEALLOCATE(sed_carbisor,STAT=dealloc_error)
  call check_iostat(dealloc_error,__LINE__,__FILE__)
  DEALLOCATE(sed_save_mask,STAT=dealloc_error)
  call check_iostat(dealloc_error,__LINE__,__FILE__)
  DEALLOCATE(sed_fsed_OLD,STAT=dealloc_error)
  call check_iostat(dealloc_error,__LINE__,__FILE__)
  DEALLOCATE(sed_fdis_OLD,STAT=dealloc_error)
  call check_iostat(dealloc_error,__LINE__,__FILE__)
  deALLOCATE(vsedcore_store,STAT=alloc_error)
  call check_iostat(alloc_error,__LINE__,__FILE__)
  DEALLOCATE(sed_Fsed_det,STAT=dealloc_error)
  call check_iostat(dealloc_error,__LINE__,__FILE__)
  DEALLOCATE(sed_Fsed_caco3,STAT=dealloc_error)
  call check_iostat(dealloc_error,__LINE__,__FILE__)
  DEALLOCATE(sed_Fsed_opal,STAT=dealloc_error)
  call check_iostat(dealloc_error,__LINE__,__FILE__)
  DEALLOCATE(sed_diag,STAT=dealloc_error)
  call check_iostat(dealloc_error,__LINE__,__FILE__)
  ! ---------------------------------------------------------- ! deallocate arrays -- lookup tables
  if (par_sed_diagen_CaCO3opt == 'ridgwell2001lookup' .OR. par_sed_diagen_CaCO3opt == 'ridgwell2001lookupvec') then
     DEALLOCATE(lookup_sed_dis_cal,STAT=dealloc_error)
     call check_iostat(dealloc_error,__LINE__,__FILE__)
  end if
  if (par_sed_diagen_CaCO3opt == 'ridgwell2001lookupvec') then
     DEALLOCATE(lookup_vec_D,STAT=dealloc_error)
     call check_iostat(dealloc_error,__LINE__,__FILE__)
     DEALLOCATE(lookup_vec_dco3,STAT=dealloc_error)
     call check_iostat(dealloc_error,__LINE__,__FILE__)
     DEALLOCATE(lookup_vec_frac,STAT=dealloc_error)
     call check_iostat(dealloc_error,__LINE__,__FILE__)
     DEALLOCATE(lookup_vec_fCorg,STAT=dealloc_error)
     call check_iostat(dealloc_error,__LINE__,__FILE__)
  end if
  if (par_sed_diagen_opalopt == 'ridgwelletal2003lookup') then
     DEALLOCATE(lookup_sed_dis_opal,STAT=dealloc_error)
     call check_iostat(dealloc_error,__LINE__,__FILE__)
  end if
  ! ---------------------------------------------------------- !
  print*,' <<< Shutdown complete'
  print*,'======================================================='
  ! ---------------------------------------------------------- !
  ! END
  ! ---------------------------------------------------------- !
END SUBROUTINE end_sedgem
! ******************************************************************************************************************************** !