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

!> Ikeda model interfaces to DART

module model_mod

! Original implementation by W. Greg Lawson, Caltech, Wednesday 14 March 2007
! Updated for the Manhattan release, 2017

use        types_mod,      only : r8, i8, i4

use    utilities_mod, only : register_module, error_handler, E_ERR, E_MSG, &
                                  nmlfileunit, do_output, find_namelist_in_file, &
                                  check_namelist_read, do_nml_file, do_nml_term

use netcdf_utilities_mod, only : nc_add_global_attribute, nc_synchronize_file, &
                                 nc_add_global_creation_time, &
                                 nc_begin_define_mode, nc_end_define_mode

use time_manager_mod,      only : time_type, set_time

use distributed_state_mod, only : get_state

use state_structure_mod,   only : add_domain

use     location_mod,      only : location_type, set_location, get_location, &
                                  get_close_obs, get_close_state, &
                                  convert_vertical_obs, convert_vertical_state

use location_io_mod,      only :  nc_write_location_atts, nc_get_location_varids, &
                                  nc_write_location

use         obs_kind_mod,  only : QTY_STATE_VARIABLE

use ensemble_manager_mod,  only : ensemble_type

use dart_time_io_mod,      only : read_model_time, write_model_time

use default_model_mod,     only : end_model, pert_model_copies, nc_write_model_vars, &
                                  init_time

implicit none
private

! these routines must be public and you cannot change the
! arguments because they will be called *from* other DART code.

!> required routines with code in this module
public :: get_model_size,         &
          get_state_meta_data,    &
          model_interpolate,      &
          shortest_time_between_assimilations, &
          static_init_model,      &
          init_conditions,        &
          adv_1step, &
          nc_write_model_atts

!> required routines where code is in other modules
public :: pert_model_copies, &
          nc_write_model_vars,    &
          init_time, &
          get_close_obs,          &
          get_close_state, &
          end_model, &
          convert_vertical_obs, &
          convert_vertical_state, &
          read_model_time, &
          write_model_time

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

!  define model parameters

! Model size is fixed for Ikeda
integer(i8), parameter :: model_size = 2
type(location_type)    :: state_loc(model_size)
type(time_type)        :: time_step

! Namelist with default values
!
real(r8) :: a  = 0.40_r8
real(r8) :: b  = 6.00_r8
real(r8) :: mu = 0.83_r8
integer  :: time_step_days      = 0
integer  :: time_step_seconds   = 3600

namelist /model_nml/ a, b, mu, time_step_days, time_step_seconds

contains

!------------------------------------------------------------------
!> Initializes class data for the Ikeda model

subroutine static_init_model()

real(r8) :: x_loc
integer  :: i, iunit, io, dom_id

! Print module information to log file and stdout.
call register_module(source, revision, revdate)

! Read the namelist entry
call find_namelist_in_file("input.nml", "model_nml", iunit)
read(iunit, nml = model_nml, iostat = io)
call check_namelist_read(iunit, io, "model_nml")

! Record the namelist values used for the run ...
if (do_nml_file()) write(nmlfileunit, nml=model_nml)
if (do_nml_term()) write(     *     , nml=model_nml)

! Define the locations of the model state variables
do i = 1, model_size
   x_loc = (i - 1.0_r8) / model_size
   state_loc(i) =  set_location(x_loc)
end do

! The time_step in terms of a time type must also be initialized.
time_step = set_time(time_step_seconds, time_step_days)

! Tell the DART I/O routines how large the model data is so they
! can read/write it.
dom_id = add_domain(model_size)

end subroutine static_init_model

!------------------------------------------------------------------
! Ikeda is an autonomous system (not dependent on time)

subroutine adv_1step(x, time)

real(r8),        intent(inout) :: x(:)
type(time_type), intent(in)    :: time

real(r8) :: t, xin(2)

xin = x

t = a - b/( xin(1)*xin(1) + xin(2)*xin(2) + 1.0_r8 )
x(1) = 1.0_r8 + mu*( xin(1)*cos(t) - xin(2)*sin(t) )
x(2) = mu*( xin(1)*sin(t) + xin(2)*cos(t) )

end subroutine adv_1step

!------------------------------------------------------------------
!> Interpolates an ensemble of expected values at the given location.
!>

subroutine model_interpolate(state_handle, ens_size, location, itype, expected_obs, istatus)

type(ensemble_type),  intent(in) :: state_handle
integer,              intent(in) :: ens_size
type(location_type), intent(in)  :: location
integer,             intent(in)  :: itype
real(r8),            intent(out) :: expected_obs(ens_size)
integer,             intent(out) :: istatus(ens_size)

integer(i8)  :: lower_index, upper_index
real(r8) :: lctn, lctnfrac

! All obs okay for now
istatus = 0

!? the original code had this?
! obs_val = MISSING_R8 ! Just to satisfy the INTENT(OUT)

! Convert location to real
lctn = get_location(location)
! Multiply by model size assuming domain is [0, 1] cyclic
lctn = model_size * lctn

lower_index = int(lctn) + 1
upper_index = lower_index + 1
if(lower_index > model_size) lower_index = lower_index - model_size
if(upper_index > model_size) upper_index = upper_index - model_size

lctnfrac = lctn - int(lctn)
expected_obs = (1.0_r8 - lctnfrac) * get_state(lower_index, state_handle) + lctnfrac * get_state(upper_index, state_handle)

end subroutine model_interpolate

!------------------------------------------------------------------
!> Returns number of items in the state vector

function get_model_size()

integer(i8) :: get_model_size

get_model_size = model_size

end function get_model_size

!------------------------------------------------------------------
!>  Initial conditions close to the attractor

subroutine init_conditions(x)

real(r8), intent(out) :: x(:)

x(1) =  0.1_r8
x(2) = -0.2_r8

end subroutine init_conditions

!------------------------------------------------------------------
!> Returns the mininum time step of the model.

function shortest_time_between_assimilations()

type(time_type) :: shortest_time_between_assimilations

shortest_time_between_assimilations = time_step

end function shortest_time_between_assimilations

!------------------------------------------------------------------
!> Given an integer index into the state vector structure, returns the
!> associated location.

subroutine get_state_meta_data(index_in, location, var_type)

integer(i8),         intent(in)  :: index_in
type(location_type), intent(out) :: location
integer,             intent(out), optional :: var_type

location = state_loc(index_in)
if (present(var_type)) var_type = QTY_STATE_VARIABLE    ! default variable quantity

end subroutine get_state_meta_data

!------------------------------------------------------------------
!> Writes the model-specific attributes to a netCDF file

subroutine nc_write_model_atts(ncid, domain_id)

integer, intent(in)  :: ncid
integer, intent(in) :: domain_id

integer :: msize

! other parts of the dart system will write the state into the file
! so this routine just needs to write any model-specific
! attributes it wants to record.

msize = int(model_size, i4)

! Write Global Attributes

call nc_begin_define_mode(ncid)

call nc_add_global_creation_time(ncid)

call nc_add_global_attribute(ncid, "model_source", source )
call nc_add_global_attribute(ncid, "model_revision", revision )
call nc_add_global_attribute(ncid, "model_revdate", revdate )

call nc_add_global_attribute(ncid, "model", "Ikeda")
call nc_add_global_attribute(ncid, "model_a", a )
call nc_add_global_attribute(ncid, "model_b", b )
call nc_add_global_attribute(ncid, "model_mu", mu )

call nc_write_location_atts(ncid, msize)
call nc_end_define_mode(ncid)
call nc_write_location(ncid, state_loc, msize)

call nc_synchronize_file(ncid)

end subroutine nc_write_model_atts

!===================================================================
! End of model_mod
!===================================================================
end module model_mod

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

max_stars_repo_name: hkershaw-brown/feature-preprocess

max_issues_repo_name: hkershaw-brown/feature-preprocess

max_forks_repo_name: hkershaw-brown/feature-preprocess


text:
      SUBROUTINE MP_BORN_AMPS_AND_WFS(P)
C
C     Generated by MadGraph5_aMC@NLO v. %(version)s, %(date)s
C     By the MadGraph5_aMC@NLO Development Team
C     Visit launchpad.net/madgraph5 and amcatnlo.web.cern.ch
C
C     Computes all the AMP and WFS in quadruple precision for the
C     phase space point P(0:3,NEXTERNAL)
C
C     Process: g g > w- t b~ QED=1 QCD=2 [ virt = QCD ] WEIGHTED=10
C
      IMPLICIT NONE
C
C     CONSTANTS
C
      INTEGER NBORNAMPS
      PARAMETER (NBORNAMPS=8)
      INTEGER    NLOOPAMPS, NCTAMPS
      PARAMETER (NLOOPAMPS=414, NCTAMPS=252)
      INTEGER    NEXTERNAL
      PARAMETER (NEXTERNAL=5)
      INTEGER    NWAVEFUNCS
      PARAMETER (NWAVEFUNCS=28)
      INTEGER    NCOMB
      PARAMETER (NCOMB=48)
      REAL*16     ZERO
      PARAMETER (ZERO=0E0_16)
      COMPLEX*32 IMAG1
      PARAMETER (IMAG1=(0E0_16,1E0_16))

C
C     ARGUMENTS
C
      REAL*16 P(0:3,NEXTERNAL)
C
C     LOCAL VARIABLES
C
      INTEGER I,J,H
      INTEGER NHEL(NEXTERNAL), IC(NEXTERNAL)
      DATA IC/NEXTERNAL*1/

C
C     GLOBAL VARIABLES
C
      INCLUDE 'mp_coupl_same_name.inc'

      INTEGER NTRY
      LOGICAL CHECKPHASE,HELDOUBLECHECKED
      REAL*8 REF
      COMMON/INIT/NTRY,CHECKPHASE,HELDOUBLECHECKED,REF

      LOGICAL GOODHEL(NCOMB)
      LOGICAL GOODAMP(NLOOPAMPS,NCOMB)
      COMMON/FILTERS/GOODAMP,GOODHEL

      INTEGER HELPICKED
      COMMON/HELCHOICE/HELPICKED

      COMPLEX*32 AMP(NBORNAMPS,NCOMB)
      COMMON/MP_AMPS/AMP
      COMPLEX*16 DPAMP(NBORNAMPS,NCOMB)
      COMMON/AMPS/DPAMP
      COMPLEX*32 W(20,NWAVEFUNCS,NCOMB)
      COMMON/MP_WFS/W

      COMPLEX*32 AMPL(3,NCTAMPS)
      COMMON/MP_AMPL/AMPL

      COMPLEX*16 DPW(20,NWAVEFUNCS,NCOMB)
      COMMON/WFCTS/DPW

      COMPLEX*16 DPAMPL(3,NLOOPAMPS)
      LOGICAL S(NLOOPAMPS)
      COMMON/AMPL/DPAMPL,S

      INTEGER HELC(NEXTERNAL,NCOMB)
      COMMON/HELCONFIGS/HELC

      LOGICAL MP_DONE_ONCE
      COMMON/MP_DONE_ONCE/MP_DONE_ONCE

C     ----------
C     BEGIN CODE
C     ---------

      MP_DONE_ONCE=.TRUE.

C     To be on the safe side, we always update the MP params here.
C     It can be redundant as this routine can be called a couple of
C      times for the same PS point during the stability checks.
C     But it is really not time consuming and I would rather be safe.
      CALL MP_UPDATE_AS_PARAM()

      DO H=1,NCOMB
        IF ((HELPICKED.EQ.H).OR.((HELPICKED.EQ.-1).AND.((CHECKPHASE.OR.
     $   .NOT.HELDOUBLECHECKED).OR.GOODHEL(H)))) THEN
          DO I=1,NEXTERNAL
            NHEL(I)=HELC(I,H)
          ENDDO
          CALL MP_VXXXXX(P(0,1),ZERO,NHEL(1),-1*IC(1),W(1,1,H))
          CALL MP_VXXXXX(P(0,2),ZERO,NHEL(2),-1*IC(2),W(1,2,H))
          CALL MP_VXXXXX(P(0,3),MDL_MW,NHEL(3),+1*IC(3),W(1,3,H))
          CALL MP_OXXXXX(P(0,4),MDL_MT,NHEL(4),+1*IC(4),W(1,4,H))
          CALL MP_IXXXXX(P(0,5),MDL_MB,NHEL(5),-1*IC(5),W(1,5,H))
          CALL MP_VVV1P0_1(W(1,1,H),W(1,2,H),GC_4,ZERO,ZERO,W(1,6,H))
          CALL MP_FFV2_1(W(1,4,H),W(1,3,H),GC_47,MDL_MB,ZERO,W(1,7,H))
C         Amplitude(s) for born diagram with ID 1
          CALL MP_FFV1_0(W(1,5,H),W(1,7,H),W(1,6,H),GC_5,AMP(1,H))
          CALL MP_FFV2_2(W(1,5,H),W(1,3,H),GC_47,MDL_MT,MDL_WT,W(1,8
     $     ,H))
C         Amplitude(s) for born diagram with ID 2
          CALL MP_FFV1_0(W(1,8,H),W(1,4,H),W(1,6,H),GC_5,AMP(2,H))
          CALL MP_FFV1_1(W(1,4,H),W(1,1,H),GC_5,MDL_MT,MDL_WT,W(1,9,H))
          CALL MP_FFV1_2(W(1,5,H),W(1,2,H),GC_5,MDL_MB,ZERO,W(1,10,H))
C         Amplitude(s) for born diagram with ID 3
          CALL MP_FFV2_0(W(1,10,H),W(1,9,H),W(1,3,H),GC_47,AMP(3,H))
C         Amplitude(s) for born diagram with ID 4
          CALL MP_FFV1_0(W(1,8,H),W(1,9,H),W(1,2,H),GC_5,AMP(4,H))
          CALL MP_FFV1_2(W(1,5,H),W(1,1,H),GC_5,MDL_MB,ZERO,W(1,11,H))
          CALL MP_FFV1_1(W(1,4,H),W(1,2,H),GC_5,MDL_MT,MDL_WT,W(1,12
     $     ,H))
C         Amplitude(s) for born diagram with ID 5
          CALL MP_FFV2_0(W(1,11,H),W(1,12,H),W(1,3,H),GC_47,AMP(5,H))
C         Amplitude(s) for born diagram with ID 6
          CALL MP_FFV1_0(W(1,11,H),W(1,7,H),W(1,2,H),GC_5,AMP(6,H))
C         Amplitude(s) for born diagram with ID 7
          CALL MP_FFV1_0(W(1,8,H),W(1,12,H),W(1,1,H),GC_5,AMP(7,H))
C         Amplitude(s) for born diagram with ID 8
          CALL MP_FFV1_0(W(1,10,H),W(1,7,H),W(1,1,H),GC_5,AMP(8,H))
          CALL MP_FFV1P0_3(W(1,5,H),W(1,7,H),GC_5,ZERO,ZERO,W(1,13,H))
C         Counter-term amplitude(s) for loop diagram number 9
          CALL MP_R2_GG_1_0(W(1,6,H),W(1,13,H),R2_GGQ,AMPL(1,1))
          CALL MP_FFV1P0_3(W(1,8,H),W(1,4,H),GC_5,ZERO,ZERO,W(1,14,H))
C         Counter-term amplitude(s) for loop diagram number 10
          CALL MP_R2_GG_1_0(W(1,6,H),W(1,14,H),R2_GGQ,AMPL(1,2))
C         Counter-term amplitude(s) for loop diagram number 11
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,13,H),UV_3GB_1EPS
     $     ,AMPL(2,3))
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,13,H),UV_3GB_1EPS
     $     ,AMPL(2,4))
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,13,H),UV_3GB_1EPS
     $     ,AMPL(2,5))
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,13,H),UV_3GB_1EPS
     $     ,AMPL(2,6))
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,13,H),UV_3GB,AMPL(1,7))
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,13,H),UV_3GB_1EPS
     $     ,AMPL(2,8))
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,13,H),UV_3GT,AMPL(1,9))
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,13,H),UV_3GB_1EPS
     $     ,AMPL(2,10))
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,13,H),UV_3GG_1EPS
     $     ,AMPL(2,11))
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,13,H),R2_3GQ,AMPL(1,12))
C         Counter-term amplitude(s) for loop diagram number 12
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,14,H),UV_3GB_1EPS
     $     ,AMPL(2,13))
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,14,H),UV_3GB_1EPS
     $     ,AMPL(2,14))
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,14,H),UV_3GB_1EPS
     $     ,AMPL(2,15))
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,14,H),UV_3GB_1EPS
     $     ,AMPL(2,16))
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,14,H),UV_3GB,AMPL(1,17))
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,14,H),UV_3GB_1EPS
     $     ,AMPL(2,18))
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,14,H),UV_3GT,AMPL(1,19))
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,14,H),UV_3GB_1EPS
     $     ,AMPL(2,20))
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,14,H),UV_3GG_1EPS
     $     ,AMPL(2,21))
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,14,H),R2_3GQ,AMPL(1,22))
C         Counter-term amplitude(s) for loop diagram number 15
          CALL MP_R2_GG_1_0(W(1,6,H),W(1,13,H),R2_GGQ,AMPL(1,23))
C         Counter-term amplitude(s) for loop diagram number 16
          CALL MP_R2_GG_1_0(W(1,6,H),W(1,14,H),R2_GGQ,AMPL(1,24))
C         Counter-term amplitude(s) for loop diagram number 17
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,13,H),R2_3GQ,AMPL(1,25))
C         Counter-term amplitude(s) for loop diagram number 18
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,14,H),R2_3GQ,AMPL(1,26))
C         Counter-term amplitude(s) for loop diagram number 21
          CALL MP_R2_GG_1_0(W(1,6,H),W(1,13,H),R2_GGQ,AMPL(1,27))
C         Counter-term amplitude(s) for loop diagram number 22
          CALL MP_R2_GG_1_0(W(1,6,H),W(1,14,H),R2_GGQ,AMPL(1,28))
C         Counter-term amplitude(s) for loop diagram number 23
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,13,H),R2_3GQ,AMPL(1,29))
C         Counter-term amplitude(s) for loop diagram number 24
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,14,H),R2_3GQ,AMPL(1,30))
C         Counter-term amplitude(s) for loop diagram number 27
          CALL MP_R2_GG_1_0(W(1,6,H),W(1,13,H),R2_GGQ,AMPL(1,31))
C         Counter-term amplitude(s) for loop diagram number 28
          CALL MP_R2_GG_1_0(W(1,6,H),W(1,14,H),R2_GGQ,AMPL(1,32))
C         Counter-term amplitude(s) for loop diagram number 29
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,13,H),R2_3GQ,AMPL(1,33))
C         Counter-term amplitude(s) for loop diagram number 30
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,14,H),R2_3GQ,AMPL(1,34))
          CALL MP_FFV1_2(W(1,5,H),W(1,6,H),GC_5,MDL_MB,ZERO,W(1,15,H))
C         Counter-term amplitude(s) for loop diagram number 33
          CALL MP_R2_QQ_1_R2_QQ_2_0(W(1,15,H),W(1,7,H),R2_QQQ,R2_QQB
     $     ,AMPL(1,35))
          CALL MP_R2_QQ_2_0(W(1,15,H),W(1,7,H),UV_BMASS,AMPL(1,36))
          CALL MP_R2_QQ_2_0(W(1,15,H),W(1,7,H),UV_BMASS_1EPS,AMPL(2
     $     ,37))
C         Counter-term amplitude(s) for loop diagram number 34
          CALL MP_R2_GG_1_R2_GG_3_0(W(1,6,H),W(1,13,H),R2_GGQ,R2_GGB
     $     ,AMPL(1,38))
C         Counter-term amplitude(s) for loop diagram number 35
          CALL MP_FFV1_0(W(1,5,H),W(1,7,H),W(1,6,H),UV_GQQQ_1EPS
     $     ,AMPL(2,39))
          CALL MP_FFV1_0(W(1,5,H),W(1,7,H),W(1,6,H),UV_GQQQ_1EPS
     $     ,AMPL(2,40))
          CALL MP_FFV1_0(W(1,5,H),W(1,7,H),W(1,6,H),UV_GQQQ_1EPS
     $     ,AMPL(2,41))
          CALL MP_FFV1_0(W(1,5,H),W(1,7,H),W(1,6,H),UV_GQQQ_1EPS
     $     ,AMPL(2,42))
          CALL MP_FFV1_0(W(1,5,H),W(1,7,H),W(1,6,H),UV_GQQB,AMPL(1,43))
          CALL MP_FFV1_0(W(1,5,H),W(1,7,H),W(1,6,H),UV_GQQQ_1EPS
     $     ,AMPL(2,44))
          CALL MP_FFV1_0(W(1,5,H),W(1,7,H),W(1,6,H),UV_GQQT,AMPL(1,45))
          CALL MP_FFV1_0(W(1,5,H),W(1,7,H),W(1,6,H),UV_GQQQ_1EPS
     $     ,AMPL(2,46))
          CALL MP_FFV1_0(W(1,5,H),W(1,7,H),W(1,6,H),UV_GQQG_1EPS
     $     ,AMPL(2,47))
          CALL MP_FFV1_0(W(1,5,H),W(1,7,H),W(1,6,H),R2_GQQ,AMPL(1,48))
C         Counter-term amplitude(s) for loop diagram number 37
          CALL MP_R2_GG_1_R2_GG_3_0(W(1,6,H),W(1,14,H),R2_GGQ,R2_GGB
     $     ,AMPL(1,49))
C         Counter-term amplitude(s) for loop diagram number 38
          CALL MP_FFV2_0(W(1,15,H),W(1,4,H),W(1,3,H),R2_SXCW,AMPL(1
     $     ,50))
          CALL MP_FFV1_1(W(1,4,H),W(1,6,H),GC_5,MDL_MT,MDL_WT,W(1,16
     $     ,H))
C         Counter-term amplitude(s) for loop diagram number 41
          CALL MP_FFV2_0(W(1,5,H),W(1,16,H),W(1,3,H),R2_SXCW,AMPL(1
     $     ,51))
          CALL MP_FFV2_1(W(1,9,H),W(1,3,H),GC_47,MDL_MB,ZERO,W(1,17,H))
C         Counter-term amplitude(s) for loop diagram number 43
          CALL MP_R2_QQ_1_R2_QQ_2_0(W(1,10,H),W(1,17,H),R2_QQQ,R2_QQB
     $     ,AMPL(1,52))
          CALL MP_R2_QQ_2_0(W(1,10,H),W(1,17,H),UV_BMASS,AMPL(1,53))
          CALL MP_R2_QQ_2_0(W(1,10,H),W(1,17,H),UV_BMASS_1EPS,AMPL(2
     $     ,54))
C         Counter-term amplitude(s) for loop diagram number 44
          CALL MP_FFV2_0(W(1,10,H),W(1,9,H),W(1,3,H),R2_SXCW,AMPL(1
     $     ,55))
C         Counter-term amplitude(s) for loop diagram number 45
          CALL MP_FFV1_0(W(1,5,H),W(1,17,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,56))
          CALL MP_FFV1_0(W(1,5,H),W(1,17,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,57))
          CALL MP_FFV1_0(W(1,5,H),W(1,17,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,58))
          CALL MP_FFV1_0(W(1,5,H),W(1,17,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,59))
          CALL MP_FFV1_0(W(1,5,H),W(1,17,H),W(1,2,H),UV_GQQB,AMPL(1
     $     ,60))
          CALL MP_FFV1_0(W(1,5,H),W(1,17,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,61))
          CALL MP_FFV1_0(W(1,5,H),W(1,17,H),W(1,2,H),UV_GQQT,AMPL(1
     $     ,62))
          CALL MP_FFV1_0(W(1,5,H),W(1,17,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,63))
          CALL MP_FFV1_0(W(1,5,H),W(1,17,H),W(1,2,H),UV_GQQG_1EPS
     $     ,AMPL(2,64))
          CALL MP_FFV1_0(W(1,5,H),W(1,17,H),W(1,2,H),R2_GQQ,AMPL(1,65))
          CALL MP_FFV1_1(W(1,9,H),W(1,2,H),GC_5,MDL_MT,MDL_WT,W(1,18
     $     ,H))
C         Counter-term amplitude(s) for loop diagram number 47
          CALL MP_FFV2_0(W(1,5,H),W(1,18,H),W(1,3,H),R2_SXCW,AMPL(1
     $     ,66))
          CALL MP_FFV2_1(W(1,12,H),W(1,3,H),GC_47,MDL_MB,ZERO,W(1,19
     $     ,H))
C         Counter-term amplitude(s) for loop diagram number 51
          CALL MP_R2_QQ_1_R2_QQ_2_0(W(1,11,H),W(1,19,H),R2_QQQ,R2_QQB
     $     ,AMPL(1,67))
          CALL MP_R2_QQ_2_0(W(1,11,H),W(1,19,H),UV_BMASS,AMPL(1,68))
          CALL MP_R2_QQ_2_0(W(1,11,H),W(1,19,H),UV_BMASS_1EPS,AMPL(2
     $     ,69))
C         Counter-term amplitude(s) for loop diagram number 52
          CALL MP_FFV2_0(W(1,11,H),W(1,12,H),W(1,3,H),R2_SXCW,AMPL(1
     $     ,70))
C         Counter-term amplitude(s) for loop diagram number 53
          CALL MP_FFV1_0(W(1,11,H),W(1,7,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,71))
          CALL MP_FFV1_0(W(1,11,H),W(1,7,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,72))
          CALL MP_FFV1_0(W(1,11,H),W(1,7,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,73))
          CALL MP_FFV1_0(W(1,11,H),W(1,7,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,74))
          CALL MP_FFV1_0(W(1,11,H),W(1,7,H),W(1,2,H),UV_GQQB,AMPL(1
     $     ,75))
          CALL MP_FFV1_0(W(1,11,H),W(1,7,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,76))
          CALL MP_FFV1_0(W(1,11,H),W(1,7,H),W(1,2,H),UV_GQQT,AMPL(1
     $     ,77))
          CALL MP_FFV1_0(W(1,11,H),W(1,7,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,78))
          CALL MP_FFV1_0(W(1,11,H),W(1,7,H),W(1,2,H),UV_GQQG_1EPS
     $     ,AMPL(2,79))
          CALL MP_FFV1_0(W(1,11,H),W(1,7,H),W(1,2,H),R2_GQQ,AMPL(1,80))
          CALL MP_FFV1_2(W(1,11,H),W(1,2,H),GC_5,MDL_MB,ZERO,W(1,20,H))
C         Counter-term amplitude(s) for loop diagram number 55
          CALL MP_R2_QQ_1_R2_QQ_2_0(W(1,20,H),W(1,7,H),R2_QQQ,R2_QQB
     $     ,AMPL(1,81))
          CALL MP_R2_QQ_2_0(W(1,20,H),W(1,7,H),UV_BMASS,AMPL(1,82))
          CALL MP_R2_QQ_2_0(W(1,20,H),W(1,7,H),UV_BMASS_1EPS,AMPL(2
     $     ,83))
          CALL MP_FFV1_1(W(1,7,H),W(1,2,H),GC_5,MDL_MB,ZERO,W(1,21,H))
C         Counter-term amplitude(s) for loop diagram number 56
          CALL MP_R2_QQ_1_R2_QQ_2_0(W(1,11,H),W(1,21,H),R2_QQQ,R2_QQB
     $     ,AMPL(1,84))
          CALL MP_R2_QQ_2_0(W(1,11,H),W(1,21,H),UV_BMASS,AMPL(1,85))
          CALL MP_R2_QQ_2_0(W(1,11,H),W(1,21,H),UV_BMASS_1EPS,AMPL(2
     $     ,86))
C         Counter-term amplitude(s) for loop diagram number 58
          CALL MP_FFV2_0(W(1,20,H),W(1,4,H),W(1,3,H),R2_SXCW,AMPL(1
     $     ,87))
C         Counter-term amplitude(s) for loop diagram number 61
          CALL MP_FFV1_0(W(1,5,H),W(1,19,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,88))
          CALL MP_FFV1_0(W(1,5,H),W(1,19,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,89))
          CALL MP_FFV1_0(W(1,5,H),W(1,19,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,90))
          CALL MP_FFV1_0(W(1,5,H),W(1,19,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,91))
          CALL MP_FFV1_0(W(1,5,H),W(1,19,H),W(1,1,H),UV_GQQB,AMPL(1
     $     ,92))
          CALL MP_FFV1_0(W(1,5,H),W(1,19,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,93))
          CALL MP_FFV1_0(W(1,5,H),W(1,19,H),W(1,1,H),UV_GQQT,AMPL(1
     $     ,94))
          CALL MP_FFV1_0(W(1,5,H),W(1,19,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,95))
          CALL MP_FFV1_0(W(1,5,H),W(1,19,H),W(1,1,H),UV_GQQG_1EPS
     $     ,AMPL(2,96))
          CALL MP_FFV1_0(W(1,5,H),W(1,19,H),W(1,1,H),R2_GQQ,AMPL(1,97))
C         Counter-term amplitude(s) for loop diagram number 63
          CALL MP_FFV1_0(W(1,10,H),W(1,7,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,98))
          CALL MP_FFV1_0(W(1,10,H),W(1,7,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,99))
          CALL MP_FFV1_0(W(1,10,H),W(1,7,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,100))
          CALL MP_FFV1_0(W(1,10,H),W(1,7,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,101))
          CALL MP_FFV1_0(W(1,10,H),W(1,7,H),W(1,1,H),UV_GQQB,AMPL(1
     $     ,102))
          CALL MP_FFV1_0(W(1,10,H),W(1,7,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,103))
          CALL MP_FFV1_0(W(1,10,H),W(1,7,H),W(1,1,H),UV_GQQT,AMPL(1
     $     ,104))
          CALL MP_FFV1_0(W(1,10,H),W(1,7,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,105))
          CALL MP_FFV1_0(W(1,10,H),W(1,7,H),W(1,1,H),UV_GQQG_1EPS
     $     ,AMPL(2,106))
          CALL MP_FFV1_0(W(1,10,H),W(1,7,H),W(1,1,H),R2_GQQ,AMPL(1
     $     ,107))
C         Counter-term amplitude(s) for loop diagram number 66
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,13,H),R2_3GQ,AMPL(1
     $     ,108))
C         Counter-term amplitude(s) for loop diagram number 68
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,14,H),R2_3GQ,AMPL(1
     $     ,109))
C         Counter-term amplitude(s) for loop diagram number 71
          CALL MP_FFV1_0(W(1,5,H),W(1,21,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,110))
          CALL MP_FFV1_0(W(1,5,H),W(1,21,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,111))
          CALL MP_FFV1_0(W(1,5,H),W(1,21,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,112))
          CALL MP_FFV1_0(W(1,5,H),W(1,21,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,113))
          CALL MP_FFV1_0(W(1,5,H),W(1,21,H),W(1,1,H),UV_GQQB,AMPL(1
     $     ,114))
          CALL MP_FFV1_0(W(1,5,H),W(1,21,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,115))
          CALL MP_FFV1_0(W(1,5,H),W(1,21,H),W(1,1,H),UV_GQQT,AMPL(1
     $     ,116))
          CALL MP_FFV1_0(W(1,5,H),W(1,21,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,117))
          CALL MP_FFV1_0(W(1,5,H),W(1,21,H),W(1,1,H),UV_GQQG_1EPS
     $     ,AMPL(2,118))
          CALL MP_FFV1_0(W(1,5,H),W(1,21,H),W(1,1,H),R2_GQQ,AMPL(1
     $     ,119))
          CALL MP_FFV1_1(W(1,12,H),W(1,1,H),GC_5,MDL_MT,MDL_WT,W(1,22
     $     ,H))
C         Counter-term amplitude(s) for loop diagram number 77
          CALL MP_FFV2_0(W(1,5,H),W(1,22,H),W(1,3,H),R2_SXCW,AMPL(1
     $     ,120))
          CALL MP_FFV1_2(W(1,10,H),W(1,1,H),GC_5,MDL_MB,ZERO,W(1,23,H))
C         Counter-term amplitude(s) for loop diagram number 81
          CALL MP_R2_QQ_1_R2_QQ_2_0(W(1,23,H),W(1,7,H),R2_QQQ,R2_QQB
     $     ,AMPL(1,121))
          CALL MP_R2_QQ_2_0(W(1,23,H),W(1,7,H),UV_BMASS,AMPL(1,122))
          CALL MP_R2_QQ_2_0(W(1,23,H),W(1,7,H),UV_BMASS_1EPS,AMPL(2
     $     ,123))
          CALL MP_FFV1_1(W(1,7,H),W(1,1,H),GC_5,MDL_MB,ZERO,W(1,24,H))
C         Counter-term amplitude(s) for loop diagram number 82
          CALL MP_R2_QQ_1_R2_QQ_2_0(W(1,10,H),W(1,24,H),R2_QQQ,R2_QQB
     $     ,AMPL(1,124))
          CALL MP_R2_QQ_2_0(W(1,10,H),W(1,24,H),UV_BMASS,AMPL(1,125))
          CALL MP_R2_QQ_2_0(W(1,10,H),W(1,24,H),UV_BMASS_1EPS,AMPL(2
     $     ,126))
C         Counter-term amplitude(s) for loop diagram number 84
          CALL MP_FFV2_0(W(1,23,H),W(1,4,H),W(1,3,H),R2_SXCW,AMPL(1
     $     ,127))
C         Counter-term amplitude(s) for loop diagram number 87
          CALL MP_FFV1_0(W(1,5,H),W(1,24,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,128))
          CALL MP_FFV1_0(W(1,5,H),W(1,24,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,129))
          CALL MP_FFV1_0(W(1,5,H),W(1,24,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,130))
          CALL MP_FFV1_0(W(1,5,H),W(1,24,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,131))
          CALL MP_FFV1_0(W(1,5,H),W(1,24,H),W(1,2,H),UV_GQQB,AMPL(1
     $     ,132))
          CALL MP_FFV1_0(W(1,5,H),W(1,24,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,133))
          CALL MP_FFV1_0(W(1,5,H),W(1,24,H),W(1,2,H),UV_GQQT,AMPL(1
     $     ,134))
          CALL MP_FFV1_0(W(1,5,H),W(1,24,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,135))
          CALL MP_FFV1_0(W(1,5,H),W(1,24,H),W(1,2,H),UV_GQQG_1EPS
     $     ,AMPL(2,136))
          CALL MP_FFV1_0(W(1,5,H),W(1,24,H),W(1,2,H),R2_GQQ,AMPL(1
     $     ,137))
C         Counter-term amplitude(s) for loop diagram number 103
          CALL MP_R2_GG_1_R2_GG_3_0(W(1,6,H),W(1,13,H),R2_GGQ,R2_GGT
     $     ,AMPL(1,138))
C         Counter-term amplitude(s) for loop diagram number 104
          CALL MP_R2_QQ_1_R2_QQ_2_0(W(1,8,H),W(1,16,H),R2_QQQ,R2_QQT
     $     ,AMPL(1,139))
          CALL MP_R2_QQ_2_0(W(1,8,H),W(1,16,H),UV_TMASS,AMPL(1,140))
          CALL MP_R2_QQ_2_0(W(1,8,H),W(1,16,H),UV_TMASS_1EPS,AMPL(2
     $     ,141))
C         Counter-term amplitude(s) for loop diagram number 105
          CALL MP_R2_GG_1_R2_GG_3_0(W(1,6,H),W(1,14,H),R2_GGQ,R2_GGT
     $     ,AMPL(1,142))
C         Counter-term amplitude(s) for loop diagram number 106
          CALL MP_FFV1_0(W(1,8,H),W(1,4,H),W(1,6,H),UV_GQQQ_1EPS
     $     ,AMPL(2,143))
          CALL MP_FFV1_0(W(1,8,H),W(1,4,H),W(1,6,H),UV_GQQQ_1EPS
     $     ,AMPL(2,144))
          CALL MP_FFV1_0(W(1,8,H),W(1,4,H),W(1,6,H),UV_GQQQ_1EPS
     $     ,AMPL(2,145))
          CALL MP_FFV1_0(W(1,8,H),W(1,4,H),W(1,6,H),UV_GQQQ_1EPS
     $     ,AMPL(2,146))
          CALL MP_FFV1_0(W(1,8,H),W(1,4,H),W(1,6,H),UV_GQQB,AMPL(1
     $     ,147))
          CALL MP_FFV1_0(W(1,8,H),W(1,4,H),W(1,6,H),UV_GQQQ_1EPS
     $     ,AMPL(2,148))
          CALL MP_FFV1_0(W(1,8,H),W(1,4,H),W(1,6,H),UV_GQQT,AMPL(1
     $     ,149))
          CALL MP_FFV1_0(W(1,8,H),W(1,4,H),W(1,6,H),UV_GQQQ_1EPS
     $     ,AMPL(2,150))
          CALL MP_FFV1_0(W(1,8,H),W(1,4,H),W(1,6,H),UV_GQQG_1EPS
     $     ,AMPL(2,151))
          CALL MP_FFV1_0(W(1,8,H),W(1,4,H),W(1,6,H),R2_GQQ,AMPL(1,152))
          CALL MP_FFV2_2(W(1,10,H),W(1,3,H),GC_47,MDL_MT,MDL_WT,W(1,25
     $     ,H))
C         Counter-term amplitude(s) for loop diagram number 108
          CALL MP_R2_QQ_1_R2_QQ_2_0(W(1,25,H),W(1,9,H),R2_QQQ,R2_QQT
     $     ,AMPL(1,153))
          CALL MP_R2_QQ_2_0(W(1,25,H),W(1,9,H),UV_TMASS,AMPL(1,154))
          CALL MP_R2_QQ_2_0(W(1,25,H),W(1,9,H),UV_TMASS_1EPS,AMPL(2
     $     ,155))
C         Counter-term amplitude(s) for loop diagram number 109
          CALL MP_FFV1_0(W(1,8,H),W(1,9,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,156))
          CALL MP_FFV1_0(W(1,8,H),W(1,9,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,157))
          CALL MP_FFV1_0(W(1,8,H),W(1,9,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,158))
          CALL MP_FFV1_0(W(1,8,H),W(1,9,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,159))
          CALL MP_FFV1_0(W(1,8,H),W(1,9,H),W(1,2,H),UV_GQQB,AMPL(1
     $     ,160))
          CALL MP_FFV1_0(W(1,8,H),W(1,9,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,161))
          CALL MP_FFV1_0(W(1,8,H),W(1,9,H),W(1,2,H),UV_GQQT,AMPL(1
     $     ,162))
          CALL MP_FFV1_0(W(1,8,H),W(1,9,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,163))
          CALL MP_FFV1_0(W(1,8,H),W(1,9,H),W(1,2,H),UV_GQQG_1EPS
     $     ,AMPL(2,164))
          CALL MP_FFV1_0(W(1,8,H),W(1,9,H),W(1,2,H),R2_GQQ,AMPL(1,165))
C         Counter-term amplitude(s) for loop diagram number 110
          CALL MP_R2_QQ_1_R2_QQ_2_0(W(1,8,H),W(1,18,H),R2_QQQ,R2_QQT
     $     ,AMPL(1,166))
          CALL MP_R2_QQ_2_0(W(1,8,H),W(1,18,H),UV_TMASS,AMPL(1,167))
          CALL MP_R2_QQ_2_0(W(1,8,H),W(1,18,H),UV_TMASS_1EPS,AMPL(2
     $     ,168))
          CALL MP_FFV1_2(W(1,8,H),W(1,2,H),GC_5,MDL_MT,MDL_WT,W(1,26
     $     ,H))
C         Counter-term amplitude(s) for loop diagram number 111
          CALL MP_R2_QQ_1_R2_QQ_2_0(W(1,26,H),W(1,9,H),R2_QQQ,R2_QQT
     $     ,AMPL(1,169))
          CALL MP_R2_QQ_2_0(W(1,26,H),W(1,9,H),UV_TMASS,AMPL(1,170))
          CALL MP_R2_QQ_2_0(W(1,26,H),W(1,9,H),UV_TMASS_1EPS,AMPL(2
     $     ,171))
          CALL MP_FFV2_2(W(1,11,H),W(1,3,H),GC_47,MDL_MT,MDL_WT,W(1,27
     $     ,H))
C         Counter-term amplitude(s) for loop diagram number 113
          CALL MP_R2_QQ_1_R2_QQ_2_0(W(1,27,H),W(1,12,H),R2_QQQ,R2_QQT
     $     ,AMPL(1,172))
          CALL MP_R2_QQ_2_0(W(1,27,H),W(1,12,H),UV_TMASS,AMPL(1,173))
          CALL MP_R2_QQ_2_0(W(1,27,H),W(1,12,H),UV_TMASS_1EPS,AMPL(2
     $     ,174))
C         Counter-term amplitude(s) for loop diagram number 114
          CALL MP_FFV1_0(W(1,27,H),W(1,4,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,175))
          CALL MP_FFV1_0(W(1,27,H),W(1,4,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,176))
          CALL MP_FFV1_0(W(1,27,H),W(1,4,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,177))
          CALL MP_FFV1_0(W(1,27,H),W(1,4,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,178))
          CALL MP_FFV1_0(W(1,27,H),W(1,4,H),W(1,2,H),UV_GQQB,AMPL(1
     $     ,179))
          CALL MP_FFV1_0(W(1,27,H),W(1,4,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,180))
          CALL MP_FFV1_0(W(1,27,H),W(1,4,H),W(1,2,H),UV_GQQT,AMPL(1
     $     ,181))
          CALL MP_FFV1_0(W(1,27,H),W(1,4,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,182))
          CALL MP_FFV1_0(W(1,27,H),W(1,4,H),W(1,2,H),UV_GQQG_1EPS
     $     ,AMPL(2,183))
          CALL MP_FFV1_0(W(1,27,H),W(1,4,H),W(1,2,H),R2_GQQ,AMPL(1
     $     ,184))
C         Counter-term amplitude(s) for loop diagram number 116
          CALL MP_FFV1_0(W(1,8,H),W(1,12,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,185))
          CALL MP_FFV1_0(W(1,8,H),W(1,12,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,186))
          CALL MP_FFV1_0(W(1,8,H),W(1,12,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,187))
          CALL MP_FFV1_0(W(1,8,H),W(1,12,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,188))
          CALL MP_FFV1_0(W(1,8,H),W(1,12,H),W(1,1,H),UV_GQQB,AMPL(1
     $     ,189))
          CALL MP_FFV1_0(W(1,8,H),W(1,12,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,190))
          CALL MP_FFV1_0(W(1,8,H),W(1,12,H),W(1,1,H),UV_GQQT,AMPL(1
     $     ,191))
          CALL MP_FFV1_0(W(1,8,H),W(1,12,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,192))
          CALL MP_FFV1_0(W(1,8,H),W(1,12,H),W(1,1,H),UV_GQQG_1EPS
     $     ,AMPL(2,193))
          CALL MP_FFV1_0(W(1,8,H),W(1,12,H),W(1,1,H),R2_GQQ,AMPL(1
     $     ,194))
C         Counter-term amplitude(s) for loop diagram number 117
          CALL MP_FFV1_0(W(1,25,H),W(1,4,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,195))
          CALL MP_FFV1_0(W(1,25,H),W(1,4,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,196))
          CALL MP_FFV1_0(W(1,25,H),W(1,4,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,197))
          CALL MP_FFV1_0(W(1,25,H),W(1,4,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,198))
          CALL MP_FFV1_0(W(1,25,H),W(1,4,H),W(1,1,H),UV_GQQB,AMPL(1
     $     ,199))
          CALL MP_FFV1_0(W(1,25,H),W(1,4,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,200))
          CALL MP_FFV1_0(W(1,25,H),W(1,4,H),W(1,1,H),UV_GQQT,AMPL(1
     $     ,201))
          CALL MP_FFV1_0(W(1,25,H),W(1,4,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,202))
          CALL MP_FFV1_0(W(1,25,H),W(1,4,H),W(1,1,H),UV_GQQG_1EPS
     $     ,AMPL(2,203))
          CALL MP_FFV1_0(W(1,25,H),W(1,4,H),W(1,1,H),R2_GQQ,AMPL(1
     $     ,204))
C         Counter-term amplitude(s) for loop diagram number 118
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,13,H),R2_3GQ,AMPL(1
     $     ,205))
C         Counter-term amplitude(s) for loop diagram number 119
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,14,H),R2_3GQ,AMPL(1
     $     ,206))
C         Counter-term amplitude(s) for loop diagram number 125
          CALL MP_FFV1_0(W(1,26,H),W(1,4,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,207))
          CALL MP_FFV1_0(W(1,26,H),W(1,4,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,208))
          CALL MP_FFV1_0(W(1,26,H),W(1,4,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,209))
          CALL MP_FFV1_0(W(1,26,H),W(1,4,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,210))
          CALL MP_FFV1_0(W(1,26,H),W(1,4,H),W(1,1,H),UV_GQQB,AMPL(1
     $     ,211))
          CALL MP_FFV1_0(W(1,26,H),W(1,4,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,212))
          CALL MP_FFV1_0(W(1,26,H),W(1,4,H),W(1,1,H),UV_GQQT,AMPL(1
     $     ,213))
          CALL MP_FFV1_0(W(1,26,H),W(1,4,H),W(1,1,H),UV_GQQQ_1EPS
     $     ,AMPL(2,214))
          CALL MP_FFV1_0(W(1,26,H),W(1,4,H),W(1,1,H),UV_GQQG_1EPS
     $     ,AMPL(2,215))
          CALL MP_FFV1_0(W(1,26,H),W(1,4,H),W(1,1,H),R2_GQQ,AMPL(1
     $     ,216))
C         Counter-term amplitude(s) for loop diagram number 126
          CALL MP_R2_QQ_1_R2_QQ_2_0(W(1,8,H),W(1,22,H),R2_QQQ,R2_QQT
     $     ,AMPL(1,217))
          CALL MP_R2_QQ_2_0(W(1,8,H),W(1,22,H),UV_TMASS,AMPL(1,218))
          CALL MP_R2_QQ_2_0(W(1,8,H),W(1,22,H),UV_TMASS_1EPS,AMPL(2
     $     ,219))
          CALL MP_FFV1_2(W(1,8,H),W(1,1,H),GC_5,MDL_MT,MDL_WT,W(1,28
     $     ,H))
C         Counter-term amplitude(s) for loop diagram number 127
          CALL MP_R2_QQ_1_R2_QQ_2_0(W(1,28,H),W(1,12,H),R2_QQQ,R2_QQT
     $     ,AMPL(1,220))
          CALL MP_R2_QQ_2_0(W(1,28,H),W(1,12,H),UV_TMASS,AMPL(1,221))
          CALL MP_R2_QQ_2_0(W(1,28,H),W(1,12,H),UV_TMASS_1EPS,AMPL(2
     $     ,222))
C         Counter-term amplitude(s) for loop diagram number 130
          CALL MP_FFV1_0(W(1,28,H),W(1,4,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,223))
          CALL MP_FFV1_0(W(1,28,H),W(1,4,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,224))
          CALL MP_FFV1_0(W(1,28,H),W(1,4,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,225))
          CALL MP_FFV1_0(W(1,28,H),W(1,4,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,226))
          CALL MP_FFV1_0(W(1,28,H),W(1,4,H),W(1,2,H),UV_GQQB,AMPL(1
     $     ,227))
          CALL MP_FFV1_0(W(1,28,H),W(1,4,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,228))
          CALL MP_FFV1_0(W(1,28,H),W(1,4,H),W(1,2,H),UV_GQQT,AMPL(1
     $     ,229))
          CALL MP_FFV1_0(W(1,28,H),W(1,4,H),W(1,2,H),UV_GQQQ_1EPS
     $     ,AMPL(2,230))
          CALL MP_FFV1_0(W(1,28,H),W(1,4,H),W(1,2,H),UV_GQQG_1EPS
     $     ,AMPL(2,231))
          CALL MP_FFV1_0(W(1,28,H),W(1,4,H),W(1,2,H),R2_GQQ,AMPL(1
     $     ,232))
C         Counter-term amplitude(s) for loop diagram number 137
          CALL MP_R2_GG_1_R2_GG_2_0(W(1,6,H),W(1,13,H),R2_GGG_1
     $     ,R2_GGG_2,AMPL(1,233))
C         Counter-term amplitude(s) for loop diagram number 138
          CALL MP_R2_GG_1_R2_GG_2_0(W(1,6,H),W(1,14,H),R2_GGG_1
     $     ,R2_GGG_2,AMPL(1,234))
C         Counter-term amplitude(s) for loop diagram number 139
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,13,H),R2_3GG,AMPL(1
     $     ,235))
C         Counter-term amplitude(s) for loop diagram number 140
          CALL MP_VVV1_0(W(1,1,H),W(1,2,H),W(1,14,H),R2_3GG,AMPL(1
     $     ,236))
C         Amplitude(s) for UVCT diagram with ID 153
          CALL MP_FFV1_0(W(1,5,H),W(1,7,H),W(1,6,H),GC_5,AMPL(1,237))
          AMPL(1,237)=AMPL(1,237)*(2.0D0*UVWFCT_G_2+2.0D0*UVWFCT_G_1
     $     +1.0D0*UVWFCT_T_0+1.0D0*UVWFCT_B_0)
C         Amplitude(s) for UVCT diagram with ID 154
          CALL MP_FFV1_0(W(1,5,H),W(1,7,H),W(1,6,H),GC_5,AMPL(2,238))
          AMPL(2,238)=AMPL(2,238)*(2.0D0*UVWFCT_B_0_1EPS+4.0D0
     $     *UVWFCT_G_2_1EPS)
C         Amplitude(s) for UVCT diagram with ID 155
          CALL MP_FFV1_0(W(1,8,H),W(1,4,H),W(1,6,H),GC_5,AMPL(1,239))
          AMPL(1,239)=AMPL(1,239)*(2.0D0*UVWFCT_G_2+2.0D0*UVWFCT_G_1
     $     +1.0D0*UVWFCT_T_0+1.0D0*UVWFCT_B_0)
C         Amplitude(s) for UVCT diagram with ID 156
          CALL MP_FFV1_0(W(1,8,H),W(1,4,H),W(1,6,H),GC_5,AMPL(2,240))
          AMPL(2,240)=AMPL(2,240)*(2.0D0*UVWFCT_B_0_1EPS+4.0D0
     $     *UVWFCT_G_2_1EPS)
C         Amplitude(s) for UVCT diagram with ID 157
          CALL MP_FFV2_0(W(1,10,H),W(1,9,H),W(1,3,H),GC_47,AMPL(1,241))
          AMPL(1,241)=AMPL(1,241)*(2.0D0*UVWFCT_G_2+2.0D0*UVWFCT_G_1
     $     +1.0D0*UVWFCT_T_0+1.0D0*UVWFCT_B_0)
C         Amplitude(s) for UVCT diagram with ID 158
          CALL MP_FFV2_0(W(1,10,H),W(1,9,H),W(1,3,H),GC_47,AMPL(2,242))
          AMPL(2,242)=AMPL(2,242)*(2.0D0*UVWFCT_B_0_1EPS+4.0D0
     $     *UVWFCT_G_2_1EPS)
C         Amplitude(s) for UVCT diagram with ID 159
          CALL MP_FFV1_0(W(1,8,H),W(1,9,H),W(1,2,H),GC_5,AMPL(1,243))
          AMPL(1,243)=AMPL(1,243)*(2.0D0*UVWFCT_G_2+2.0D0*UVWFCT_G_1
     $     +1.0D0*UVWFCT_T_0+1.0D0*UVWFCT_B_0)
C         Amplitude(s) for UVCT diagram with ID 160
          CALL MP_FFV1_0(W(1,8,H),W(1,9,H),W(1,2,H),GC_5,AMPL(2,244))
          AMPL(2,244)=AMPL(2,244)*(2.0D0*UVWFCT_B_0_1EPS+4.0D0
     $     *UVWFCT_G_2_1EPS)
C         Amplitude(s) for UVCT diagram with ID 161
          CALL MP_FFV2_0(W(1,11,H),W(1,12,H),W(1,3,H),GC_47,AMPL(1
     $     ,245))
          AMPL(1,245)=AMPL(1,245)*(2.0D0*UVWFCT_G_2+2.0D0*UVWFCT_G_1
     $     +1.0D0*UVWFCT_T_0+1.0D0*UVWFCT_B_0)
C         Amplitude(s) for UVCT diagram with ID 162
          CALL MP_FFV2_0(W(1,11,H),W(1,12,H),W(1,3,H),GC_47,AMPL(2
     $     ,246))
          AMPL(2,246)=AMPL(2,246)*(2.0D0*UVWFCT_B_0_1EPS+4.0D0
     $     *UVWFCT_G_2_1EPS)
C         Amplitude(s) for UVCT diagram with ID 163
          CALL MP_FFV1_0(W(1,11,H),W(1,7,H),W(1,2,H),GC_5,AMPL(1,247))
          AMPL(1,247)=AMPL(1,247)*(2.0D0*UVWFCT_G_2+2.0D0*UVWFCT_G_1
     $     +1.0D0*UVWFCT_T_0+1.0D0*UVWFCT_B_0)
C         Amplitude(s) for UVCT diagram with ID 164
          CALL MP_FFV1_0(W(1,11,H),W(1,7,H),W(1,2,H),GC_5,AMPL(2,248))
          AMPL(2,248)=AMPL(2,248)*(2.0D0*UVWFCT_B_0_1EPS+4.0D0
     $     *UVWFCT_G_2_1EPS)
C         Amplitude(s) for UVCT diagram with ID 165
          CALL MP_FFV1_0(W(1,8,H),W(1,12,H),W(1,1,H),GC_5,AMPL(1,249))
          AMPL(1,249)=AMPL(1,249)*(2.0D0*UVWFCT_G_2+2.0D0*UVWFCT_G_1
     $     +1.0D0*UVWFCT_T_0+1.0D0*UVWFCT_B_0)
C         Amplitude(s) for UVCT diagram with ID 166
          CALL MP_FFV1_0(W(1,8,H),W(1,12,H),W(1,1,H),GC_5,AMPL(2,250))
          AMPL(2,250)=AMPL(2,250)*(2.0D0*UVWFCT_B_0_1EPS+4.0D0
     $     *UVWFCT_G_2_1EPS)
C         Amplitude(s) for UVCT diagram with ID 167
          CALL MP_FFV1_0(W(1,10,H),W(1,7,H),W(1,1,H),GC_5,AMPL(1,251))
          AMPL(1,251)=AMPL(1,251)*(2.0D0*UVWFCT_G_2+2.0D0*UVWFCT_G_1
     $     +1.0D0*UVWFCT_T_0+1.0D0*UVWFCT_B_0)
C         Amplitude(s) for UVCT diagram with ID 168
          CALL MP_FFV1_0(W(1,10,H),W(1,7,H),W(1,1,H),GC_5,AMPL(2,252))
          AMPL(2,252)=AMPL(2,252)*(2.0D0*UVWFCT_B_0_1EPS+4.0D0
     $     *UVWFCT_G_2_1EPS)
C         Copy the qp wfs to the dp ones as they are used to setup the
C          CT calls.
          DO I=1,NWAVEFUNCS
            DO J=1,20
              DPW(J,I,H)=W(J,I,H)
            ENDDO
          ENDDO
C         Same for the counterterms amplitudes
          DO I=1,NCTAMPS
            DO J=1,3
              DPAMPL(J,I)=AMPL(J,I)
              S(I)=.TRUE.
            ENDDO
          ENDDO
          DO I=1,NBORNAMPS
            DPAMP(I,H)=AMP(I,H)
          ENDDO
        ENDIF
      ENDDO

      END

ext: f


text:
      program titan
c
c***********************************************************************
c     one-dimensional  adaptive-grid  turbulent  radiation hydrodynamics
c***********************************************************************
c
      include'titan.imp'
      include'titan.par'
      include'titan.com'
      include'titan.dat'
c
c=======================================================================
c     initialize all commons
c=======================================================================
c
      xindef = 0.0D0
c
c=======================================================================
c     open files
c=======================================================================
c
      call opnfil
c
c=======================================================================
c     set logical switches and input parameters; recover or generate
c     initial model
c=======================================================================
c
      call start
c
c=======================================================================
c     time integration
c=======================================================================
c
      do 1 jstep = jsteps, jstepe
c
c-----------------------------------------------------------------------
c     perform a single integration step
c-----------------------------------------------------------------------
c
      call step
c
c-----------------------------------------------------------------------
c     archival output
c-----------------------------------------------------------------------
c
      call archive
c
c-----------------------------------------------------------------------
c     model output and model evolution
c-----------------------------------------------------------------------
c
      call writout
c
      call writsty
c
c-----------------------------------------------------------------------
c     terminate run
c-----------------------------------------------------------------------
c
      if (timen .ge. tmax) then
                           call clzfil
                           stop
      end if
c
    1 continue
c
c=======================================================================
c     close files
c=======================================================================
c
      call clzfil
c
      stop
      end

max_stars_repo_name: matthewturk/lca-titan

max_issues_repo_name: matthewturk/lca-titan

max_forks_repo_name: matthewturk/lca-titan


text:
! eight_queens.f90 --
!    Program to solve the classical problem of positioning
!    eight queens on a chessboard so that none can reach
!    another in one move.
!
!    This illustrates the use of the backtracking module.
!
module backtracking_data
    implicit none
    type SOLUTION_DATA
        integer, dimension(8) :: row
    end type SOLUTION_DATA

end module backtracking_data

module eight_queens
    use backtracking_data
    implicit none

    type(SOLUTION_DATA), dimension(:), pointer  :: all_solutions
contains

! generate --
!     Subroutine to generate the possible solutions at each stage
! Arguments:
!     base        The basic solution that new solutions will be
!                 derived from
!     stage       Index of the current stage in the construction
!     solutions   Array of new solutions that need to be examined
! Note:
!     The solutions that are returned in the (allocated)
!     array are simply feasible solutions that need to
!     be inspected further.
!     To keep the memory management clear, the subroutine
!     "free" cleans up the array of feasible solutions.
!
subroutine generate( base, stage, solutions )
    type(SOLUTION_DATA), intent(in)             :: base
    integer, intent(in)                         :: stage
    type(SOLUTION_DATA), dimension(:), pointer  :: solutions

    integer :: i

    !
    ! If stage <= 8, there are 8 possible solutions
    !
    if ( stage <= 8 ) then
        allocate( solutions(8) )
    else
        nullify( solutions )
        return
    endif

    !
    ! Construct them (be sure to copy the base
    ! solution first!)
    !
    solutions(:)            = base
    solutions(:)%row(stage) = (/ (i, i=1,8 ) /)
end subroutine generate

! free --
!     Subroutine to clean up the memory used by the intermediate
!     solutions
! Arguments:
!     solutions   Array of solutions that need to be cleaned up
!
subroutine free( solutions )
    type(SOLUTION_DATA), dimension(:), pointer  :: solutions

    deallocate( solutions )

end subroutine free

! acceptable --
!     Function to check if a possible solution is acceptable
! Arguments:
!     solution    The solution to be examined
!     stage       The current stage
! Returns:
!     .true. if the solution is acceptable, .false. otherwise
!
logical function acceptable( solution, stage )
    type(SOLUTION_DATA), intent(in) :: solution
    integer, intent(in)             :: stage

    logical :: clash
    integer  :: i
    integer  :: diff

    !
    ! We need to check the current queen only - all others
    ! have already been checked.
    !
    ! So:
    ! The new queen should not be on the same row as any others
    !
    clash = any( solution%row(1:stage-1) .eq. solution%row(stage) )

    !
    ! Check the diagonals
    !
    do i = 1,stage-1
        diff = abs( solution%row(i)-solution%row(stage) )
        clash = clash .or. ( diff .eq. (stage-i) )
    enddo

    acceptable = .not. clash

end function acceptable

! collect --
!     Subroutine to collect all solutions (or do something else)
! Arguments:
!     solution    Solution that was found
!     stop        Flag that indicates whether to stop or not
!
subroutine collect( solution, stop )
    type(SOLUTION_DATA), intent(in) :: solution
    logical, intent(out)            :: stop

    type(SOLUTION_DATA), dimension(:), pointer  :: new

    stop = .false. ! We want to collect all solutions

    allocate( new(size(all_solutions)+1) )

    new(1:size(all_solutions)) = all_solutions
    new(size(new))             = solution

    deallocate( all_solutions )
    all_solutions => new

end subroutine collect

end module eight_queens

program eightq

    use eight_queens
    use backtracking
    implicit none

    integer                           :: i
    integer                           :: nostage
    type(SOLUTION_DATA), dimension(1) :: base

    !
    ! There is no need to initialise the base solution in this example
    ! so just move on!
    !
    allocate( all_solutions(0) ) ! To be on the safe side

    nostage = 8

    call bt_solve( base, nostage, generate, acceptable, free, collect )

    !
    ! Now print the solutions ...
    !
    write(*,*) 'Number of solutions found: ', size(all_solutions)
    do i = 1,size(all_solutions)
        write(*,'(8i3)' ) all_solutions(i)%row
    enddo
end program

max_stars_repo_name: dorrabbkhan/atlnts-infrastructure

max_issues_repo_name: TerribleDev/Fortran-docker-mvc

max_forks_repo_name: TerribleDev/Fortran-docker-mvc


text:
      MODULE hplusf_I
      INTERFACE
!...Generated by Pacific-Sierra Research 77to90  4.4G  21:23:38  03/14/06
      SUBROUTINE hplusf (F, H, NORBS)
      USE vast_kind_param,ONLY: DOUBLE
      integer, INTENT(IN) :: NORBS
      real(DOUBLE), DIMENSION(NORBS,NORBS), INTENT(INOUT) :: F
      real(DOUBLE), DIMENSION(NORBS,NORBS), INTENT(IN) :: H
      END SUBROUTINE
      END INTERFACE
      END MODULE

max_stars_repo_name: openmopac/MOPAC-archive

max_issues_repo_name: openmopac/MOPAC-archive

max_forks_repo_name: openmopac/MOPAC-archive