#!/usr/bin/env python3

#
# (nubeam) nbi_ modules code generator
# for modular Monte Carlo package ... dmc 2 Jan 2002
#
# read information on (dynamic) array dimensions, input quantities,
# output quantities, state quantities, etc., and generate modules
#
#   nbi_dimensions_mod.f90    ! array dimensions module (private to nubeam)
#   nbi_com_mod.f90           ! nubeam scalars and arrays (private to nubeam)
#   nbi_types.f90             ! public module containing compound types
#                             !   for nubeam i/o and control interfaces
#
# see "codesys/source/nubeam/nbspec.dat" for a commented description
# of the input data, which is divided up into sections.

#--------------------------------------------------------------------------
# global items...
from nbigen_global import *

#--------------------------------------------------------------------------
# the work is done in subfunctions nbigen_sub...
from nbigen_sub import *

#--------------------------------------------------------------------------
#  output files (see nbigen_global) -- write generic header lines

f_cxnrm.write("! written by nbigen.py\n")
f_cxnrm.write("! *** do not edit *** (use nbigen.py instead)\n")

f_nbidim.write("! written by nbigen.py\n")
f_nbidim.write("! *** do not edit *** (use nbigen.py instead)\n")
f_nbidim.write("module nbi_dimensions\n")
f_nbidim.write("  implicit NONE\n")
f_nbidim.write("  SAVE\n")
f_nbidim.write(" \n")
f_nbidim.write("  logical :: nbidim_init  = .FALSE.  ! 1st initialization\n")
f_nbidim.write("  logical :: nbidim_initf = .FALSE.  ! final initialization\n")
f_nbidim.write(" \n")

f_nbicom.write("! written by nbigen.py\n")
f_nbicom.write("! *** do not edit *** (use nbigen.py instead)\n")
f_nbicom.write("module nbi_com\n")
f_nbicom.write("  use iso_c_binding, only: fp => c_double\n")
f_nbicom.write("  use physconst_mod, only: xpi=>pi, twopi, xe=>kb_eV\n")
f_nbicom.write("  use physconst_mod, only: xmu=>RMU0, degrad=>deg2rad\n")
f_nbicom.write("  use physconst_mod, only: zel, VC, zmp=>mp_g, zmtocm\n")
f_nbicom.write("  use physconst_mod, only: epslon, epsinv\n")
f_nbicom.write("  use physconst_mod, only: zero,half,one,two\n")
f_nbicom.write("  use nbi_dimensions\n")
f_nbicom.write("  implicit NONE\n")
f_nbicom.write("  SAVE\n")
f_nbicom.write(" \n")
f_nbicom.write("  real(fp), parameter :: zc=VC*zmtocm \n")
f_nbicom.write(" \n")

f_nbityp.write("! written by nbigen.py\n")
f_nbityp.write("! *** do not edit *** (use nbigen.py instead)\n")
f_nbityp.write("module nbi_types\n")
f_nbityp.write("  use iso_c_binding, only: fp => c_double\n")
f_nbityp.write("  implicit NONE\n")
f_nbityp.write(" \n")

f_nbipst.write("""
! written by nbigen.py
! *** do not edit *** (use nbigen.py instead)

module nbi_pstypes

  ! Plasma State and alternate control inputs for NUBEAM
  ! Items left at default values are not transferred.

  ! Note SAVEd data.  These control routines are probably not thread safe and
  ! should be likely be executed only by a master process.
  use iso_c_binding, only: fp => c_double
  use plasma_state_mod
  use nbi_types
  use ezcdf
  use xplasma_obj_instance
  implicit NONE

  PRIVATE
  SAVE

  ! **default** marker values
  INTEGER, PARAMETER, PUBLIC :: idflt_nbips = -123456789
  real(fp), PARAMETER, PUBLIC :: r8dflt_nbips = -1.2345678901e+203_fp

  ! public data types:
  public :: nbi_ctrl_init,nbi_ctrl_update
  public :: nbi_ps_init,nbi_ps_update

  ! public methods:
  public :: nbi_ctrl_init_dflt,nbi_ctrl_update_dflt
  public :: nbi_ctrl_init_read,nbi_ctrl_update_read
  public :: nbi_ctrl_init_write,nbi_ctrl_update_write
  public :: nbi_ctrl_init_cdfwrite,nbi_ctrl_update_cdfwrite
  public :: nbi_ctrl_init_cdfread,nbi_ctrl_update_cdfread
  public :: nbi_ps_init_dflt,nbi_ps_update_dflt
  public :: nubeam_ctrl_init,nubeam_ctrl_step,nubeam_ctrl_nostep
  public :: nubeam_ctrl_step_child

  public :: inbi_logical  ! integer function: .TRUE.-> 1, .FALSE.-> 0

  ! private interfaces:
  interface trans
    module procedure trans_I0,trans_I1,trans_I2
    module procedure trans_L0,trans_L1
    module procedure trans_D0,trans_D1,trans_D2
    module procedure trans_C0
  end interface

  interface dwrite
    module procedure dwrite_I0,dwrite_I1,dwrite_I2
    module procedure dwrite_D0,dwrite_D1,dwrite_D2
    module procedure dwrite_C0
  end interface

  LOGICAL :: init_called = .FALSE.

  ! public methods for setting character data:
""")

f_nbinit.write("! written by nbigen.py\n")
f_nbinit.write("! *** do not edit *** (use nbigen.py instead)\n")
f_nbinit.write(" \n")

f_nbiset.write("! written by nbigen.py\n")
f_nbiset.write("! *** do not edit *** (use nbigen.py instead)\n")
f_nbiset.write(" \n")

f_nbiget.write("! written by nbigen.py\n")
f_nbiget.write("! *** do not edit *** (use nbigen.py instead)\n")
f_nbiget.write(" \n")

f_update.write("! written by nbigen.py\n")
f_update.write("! *** do not edit *** (use nbigen.py instead)\n")
f_update.write(" \n")

f_alloc.write("! written by nbigen.py\n")
f_alloc.write("! *** do not edit *** (use nbigen.py instead)\n")
f_alloc.write(" \n")

f_alloc2.write("! written by nbigen.py\n")
f_alloc2.write("! *** do not edit *** (use nbigen.py instead)\n")
f_alloc2.write(" \n")

f_alloctr.write("! written by nbigen.py\n")
f_alloctr.write("! *** do not edit *** (use nbigen.py instead)\n")
f_alloctr.write(" \n")

f_alloctrz.write("! written by nbigen.py\n")
f_alloctrz.write("! *** do not edit *** (use nbigen.py instead)\n")
f_alloctrz.write(" \n")

f_alloclst.write("! written by nbigen.py\n")
f_alloclst.write("! *** do not edit *** (use nbigen.py instead)\n")
f_alloclst.write(" \n")

f_nbilst.write("! written by nbigen.py\n")
f_nbilst.write("! *** do not edit *** (use nbigen.py instead)\n")
f_nbilst.write(" \n")

f_nbizone.write("! written by nbigen.py\n")
f_nbizone.write("! *** do not edit *** (use nbigen.py instead)\n")
f_nbizone.write(" \n")

f_allocm.write("! written by nbigen.py\n")
f_allocm.write("! *** do not edit *** (use nbigen.py instead)\n")
f_allocm.write(" \n")

f_reallocm.write("! written by nbigen.py\n")
f_reallocm.write("! *** do not edit *** (use nbigen.py instead)\n")
f_reallocm.write(" \n")

f_dalloc.write("! written by nbigen.py\n")
f_dalloc.write("! *** do not edit *** (use nbigen.py instead)\n")
f_dalloc.write(" \n")

f_spltexpnd.write("! written by nbigen.py\n")
f_spltexpnd.write("! *** do not edit *** (use nbigen.py instead)\n")
f_spltexpnd.write(" \n")

f_dalloctr.write("! written by nbigen.py\n")
f_dalloctr.write("! *** do not edit *** (use nbigen.py instead)\n")
f_dalloctr.write(" \n")

f_dalloctrz.write("! written by nbigen.py\n")
f_dalloctrz.write("! *** do not edit *** (use nbigen.py instead)\n")
f_dalloctrz.write(" \n")

f_dalloclst.write("! written by nbigen.py\n")
f_dalloclst.write("! *** do not edit *** (use nbigen.py instead)\n")
f_dalloclst.write(" \n")

f_statio.write("! written by nbigen.py\n")
f_statio.write("! *** do not edit *** (use nbigen.py instead)\n")
f_statio.write(" \n")
nbio_start(f_statio, "state", ["0","1","2","3"])
nbio_start_ptcl(f_statio, "state", ["2"])

f_inp_io.write("! written by nbigen.py\n")
f_inp_io.write("! *** do not edit *** (use nbigen.py instead)\n")
f_inp_io.write(" \n")

f_out_io.write("! written by nbigen.py\n")
f_out_io.write("! *** do not edit *** (use nbigen.py instead)\n")
f_out_io.write(" \n")

f_asciio.write("! written by nbigen.py\n")
f_asciio.write("! *** do not edit *** (use nbigen.py instead)\n")
f_asciio.write(" \n")

f_pcopy.write("! written by nbigen.py\n")
f_pcopy.write("! *** do not edit *** (use nbigen.py instead)\n")
f_pcopy.write(" \n")

f_wrdpt.write("! written by nbigen.py\n")
f_wrdpt.write("! *** do not edit *** (use nbigen.py instead)\n")
f_wrdpt.write(" \n")

f_nboget.write("! written by nbigen.py\n")
f_nboget.write("! *** do not edit *** (use nbigen.py instead)\n")
f_nboget.write(" \n")

f_nboclr.write("! written by nbigen.py\n")
f_nboclr.write("! *** do not edit *** (use nbigen.py instead)\n")
f_nboclr.write(" \n")

f_nboldx.write("! written by nbigen.py\n")
f_nboldx.write("! *** do not edit *** (use nbigen.py instead)\n")
f_nboldx.write(" \n")

f_nboldxf.write("! written by nbigen.py\n")
f_nboldxf.write("! *** do not edit *** (use nbigen.py instead)\n")
f_nboldxf.write(" \n")

f_bcast.write("! written by nbigen.py\n")
f_bcast.write("! *** do not edit *** (use nbigen.py instead)\n")
f_bcast.write(" \n")

f_bcast_st.write("! written by nbigen.py\n")
f_bcast_st.write("! *** do not edit *** (use nbigen.py instead)\n")
f_bcast_st.write(" \n")

f_bcast_st_get.write("! written by nbigen.py\n")
f_bcast_st_get.write("! *** do not edit *** (use nbigen.py instead)\n")
f_bcast_st_get.write(" \n")

#--------------------------------------------------------------------------
f = open("nubeam_hlp.tmp","r")
nubeam_hlp_lines = f.readlines()
f.close()

istop = 0
for line in nubeam_hlp_lines:
    if istop == 0:
        f_help.write(line)
        if line.strip() == "!-->PYTHON_START":
            istop = 1

f_help.write("  ! (nbigen.py: python3 generated .hlp code, do not edit)\n")

#--------------------------------------------------------------------------
f = open("nbspec.dat","r")
lines = f.readlines()
f.close()

#--------------------------------------------------------------------------
# first standardization of input text

clines = []

for line in lines:

    # throw out # comments, leading/trailing whitespace, and blank lines

    line = line.strip()

    if len(line) == 0:
        continue

    if line[0] != "#":

        # if an "!" (fortran) comment is present, put it on a separate line

        ifind = line.find("!")
        if ifind > 0:
            cline = line[ifind:]
            line = line[:ifind].strip()

            clines.append(line)
            clines.append(cline)

        else:
            clines.append(line)

#for line in clines:
#    print line

#-------------------------------------------------------------------------
# split into sections; all lines must be in labeled sections, started by
# a line of the form "Section: <section-name>".

iline = 0
current_section = "NONE"
clines.append("SECTION: END")

for line in clines:

    iline = iline + 1

    words = line.split()
    word0 = words[0].upper()

    if word0 == "SECTION:":
        if current_section == "NONE":
            if iline > 1:
                print('nbigen.py: line before "SECTION:" specification.')
                print(line)
                raise nbigen_error

        elif current_section == "END":
            pass

        else:
            # before reassigning current_section, process the preceding section

            if current_section == "ARRAY_DIMENSIONS":
                io_suffix = "0"
                nbigen_array_dimensions(slines,current_section)

            elif current_section == "CONSTANTS":
                io_suffix = "0A"
                nbigen_constants(slines,current_section)

            elif current_section == "INPUTS":
                io_suffix = "1"
                nbigen_input(slines,current_section)

            elif current_section == "INTERNAL":
                io_suffix = "2"
                nbigen_internal(slines,current_section)

            elif current_section == "OUTPUTS":
                io_suffix = "3"
                nbigen_output(slines,current_section)

            else:
                print('nbigen.py: unknown section name: ',current_section)
                raise nbigen_error

        if len(words) != 2:
            print('nbigen.py: expected syntax: "SECTION: <section-name>"')
            print(line)
            raise nbigen_error

        current_section = words[1].upper()

        print(current_section)

        slines = []

    else:

        slines.append(line)

nbigen_pcopy("process pll buffer requests")

#-------------------------------------------------------------------------
#  output files -- write generic trailer lines & close

f_nbidim.write(" \n")
f_nbidim.write("end module nbi_dimensions\n")
f_nbidim.close()

f_nbicom.write(" \n")
f_nbicom.write("end module nbi_com\n")
f_nbicom.close()

f_nbityp.write(" \n")
f_nbityp.write("end module nbi_types\n")
f_nbityp.close()

f_nbipst.write("""
  ! PUBLIC routines (written verbatim from nubeam/nbigen.py)

  subroutine nubeam_ctrl_init(ss,nbi_ctrl,ierr)

    ! initialize NUBEAM controls from plasma state & from nbi_ctrl_init data
    ! MPI runs: only myidd.eq.0 thread needs to call this.

    type (plasma_state) :: ss
    type (nbi_ctrl_init) :: nbi_ctrl
    integer, intent(out) :: ierr

    ! local:

    type (nbi_ps_init) :: psinit

    integer :: myidd
    real(fp) :: zcptim_loc1,zcptim_loc2
    integer :: ilun_msg = 6
    !-------------------------------------

    call nbi_get_myid(myidd)

    if(myidd.eq.0) then

       call cpu_time(zcptim_loc1)

       ! transfer state data (call hand maintained routine)
       call nubeam_ctrl_psinit(ss,psinit,ierr)
       if(ierr.ne.0) return

       ! initialize nubeam internals (nbi_com_mod) -- allocate arrays in nubeam
       call nbi_ctrl_init_apply(nbi_ctrl, psinit, ierr)
       if(ierr.ne.0) return

       call nbi_datchk(ierr)
       if(ierr.ne.0) return

       call cpu_time(zcptim_loc2)
       write(ilun_msg,'(1x,a,1x,1pe11.4)') &
            "cpu time (sec) in nubeam_ctrl_init: ", zcptim_loc2-zcptim_loc1
    endif

  end subroutine nubeam_ctrl_init

  subroutine nubeam_ctrl_step(ss_in,ss_out,nbi_ctrl,ierr)

    ! update NUBEAM controls from plasma state & from nbi_ctrl_init data
    ! and execute a NUBEAM step

    type (plasma_state) :: ss_in,ss_out  ! input, output states

    type (nbi_ctrl_update) :: nbi_ctrl
    integer, intent(out) :: ierr
    ! local:

    type (nbi_ps_update) :: psupdate

    real(fp) :: zcptime,ztim1,ztim2
    integer :: myidd
    integer :: imem

    real(fp) :: zcptim_loc
    !-------------------------------------

    call cpu_time(zcptim_loc)

    call nbi_get_myid(myidd)

    if (myidd.eq.0) then
       call cpu_time(ztim1)

       if(nbi_ctrl%xplasma_in_memory.ne.idflt_nbips) then
          imem = nbi_ctrl%xplasma_in_memory
       else
          call nbi_get_grid(zgrid)
          imem = zgrid%xplasma_in_memory
       endif

       ! transfer state data (call hand maintained routine)
       call nubeam_ctrl_psupdate(imem, ss_in,psupdate, ierr)
       if(ierr.ne.0) return

       call nbi_ctrl_update_apply(nbi_ctrl, psupdate, ierr)
       if(ierr.ne.0) return

       call cpu_time(ztim2)
       zcptime = ztim2 - ztim1
    endif

    call nubeam_step(ss_out,zcptime,ierr)

    if (myidd.eq.0) then
       if(imem.lt.0) then
          call nubeam_ctrl_psupdate_cleanup(ierr)
       endif
    endif

    call nubeam_mpi_timer(zcptim_loc)

  end subroutine nubeam_ctrl_step

  subroutine nubeam_ctrl_step_child(ierr)

    ! execute a NUBEAM step -- MPI child process

    ! (myidd.gt.0) CPU threads can call this instead of nubeam_ctrl_step
    ! for a simplified argument list

    integer, intent(out) :: ierr
    !---------------------------------
    integer :: myidd

    real(fp) :: zcptim_loc
    !-------------------------------------

    call cpu_time(zcptim_loc)

    call nbi_get_myid(myidd)

    if (myidd.eq.0) then
       ierr=1
       call errmsg_exit(' ?? nubeam_ctrl_step_child: myidd=0 call to nubeam_ctrl_step_child')
       return
    endif
    call nubeam_step_child(ierr)

    call nubeam_mpi_timer(zcptim_loc)

  end subroutine nubeam_ctrl_step_child

  subroutine nubeam_ctrl_nostep(ss_in,ierr)

    ! use a plasma_state object to complete a NUBEAM internal state,
    ! without performing a full NUBEAM time step.
    ! MPI runs: only myidd.eq.0 thread needs to call this.

    type (plasma_state) :: ss_in  ! input plasma state
    integer, intent(out) :: ierr

    ! local:

    type (nbi_ctrl_update) :: nbi_ctrl

    type (nbi_ps_update) :: psupdate

    real(fp) :: zcptime,ztim1,ztim2

    integer :: myidd
    real(fp) :: zcptim_loc
    !-------------------------------------

    call nbi_get_myid(myidd)

    if (myidd.eq.0) then
       call cpu_time(ztim1)

       ! transfer state data (call hand maintained routine)
       call nubeam_ctrl_psupdate(-1, ss_in, psupdate, ierr)
       if(ierr.ne.0) return

       call nbi_ctrl_update_dflt(nbi_ctrl)

       call nbi_ctrl_update_apply(nbi_ctrl, psupdate, ierr)
       if(ierr.ne.0) return

       call nbi_interp_profiles(ierr)
       if(ierr.ne.0) return

       call nbstart_init(ierr)
       if(ierr.ne.0) return

       ! because nubeam_ctrl_psupdate(-1, ...) was called, need this also:
       call nubeam_ctrl_psupdate_cleanup(ierr)
       if(ierr.ne.0) return

       call cpu_time(ztim2)
       zcptime = ztim2 - ztim1
    endif

  end subroutine nubeam_ctrl_nostep

  ! PRIVATE routine to count number of fast species

  integer function inumfast(imin)

    integer, intent(in) :: imin   ! minimum result allowed

    !----------------------
    integer :: isum
    integer :: insb,ii,jj,imatch,iai,izi,ia(200),iz(200)
    !----------------------

    isum = zminority%nmini

    if(zfusion%nlfhe3) isum = isum + 1
    if(zfusion%nlfhe4) isum = isum + 1
    if(zfusion%nlfst) isum = isum + 1
    if(zfusion%nlfsp) isum = isum + 1
    if(zfusion%nlfsp14) isum = isum + 1

    insb = 0
    do ii=1,zbeams%nbeam
       izi = zbeams%xzbeama(ii) + 0.1_fp
       if(izi.eq.0) exit

       iai = zbeams%abeama(ii) + 0.1_fp
       if(iai.eq.0) exit

       imatch = 0
       do jj=1,insb
          if((izi.eq.iz(jj)).and.(iai.eq.ia(jj))) then
             imatch=jj
             exit
          endif
       enddo

       if(imatch.eq.0) then
          insb = insb + 1
          iz(insb) = izi
          ia(insb) = iai
       endif
    enddo

    isum = isum + insb

    isum = max(isum,imin)
    inumfast = isum

  end function inumfast

  ! PRIVATE data transfer routines

  subroutine trans_I0(iin,iout)
    integer :: iin,iout

    if(iin.ne.idflt_nbips) iout=iin

  end subroutine trans_I0

  subroutine trans_I1(iin,iout)
    integer, dimension(:) :: iin,iout

    integer :: ii

    do ii=1,size(iin)
       if(iin(ii).ne.idflt_nbips) iout(ii)=iin(ii)
    enddo

  end subroutine trans_I1

  subroutine trans_I2(iin,iout)
    integer, dimension(:,:) :: iin,iout

    integer :: ii,jj

    do jj=1,size(iin,2)
       do ii=1,size(iin,1)
         if(iin(ii,jj).ne.idflt_nbips) iout(ii,jj)=iin(ii,jj)
       enddo
    enddo

  end subroutine trans_I2

  subroutine trans_L0(iin,iout)
    integer :: iin
    logical :: iout

    if(iin.ne.idflt_nbips) iout= (iin.NE.0)

  end subroutine trans_L0

  subroutine trans_L1(iin,iout)
    integer, dimension(:) :: iin
    logical, dimension(:) :: iout

    integer :: ii

    do ii=1,size(iin)
       if(iin(ii).ne.idflt_nbips) iout(ii)= (iin(ii).NE.0)
    enddo

  end subroutine trans_L1

  subroutine trans_D0(zin,zout)
    real(fp) :: zin,zout

    if(zin.ne.r8dflt_nbips) zout=zin

  end subroutine trans_D0

  subroutine trans_D1(zin,zout)
    real(fp), dimension(:) :: zin,zout

    integer :: ii

    do ii=1,size(zin)
       if(zin(ii).ne.r8dflt_nbips) zout(ii)=zin(ii)
    enddo

  end subroutine trans_D1

  subroutine trans_D2(zin,zout)
    real(fp), dimension(:,:) :: zin,zout

    integer :: ii,jj

    do jj=1,size(zin,2)
       do ii=1,size(zin,1)
          if(zin(ii,jj).ne.r8dflt_nbips) zout(ii,jj)=zin(ii,jj)
       enddo
    enddo

  end subroutine trans_D2

  subroutine trans_C0(cin,cout)
    character*(*) :: cin,cout

    cout=cin

  end subroutine trans_C0

  ! PRIVATE data file write routines -- only right non-default values

  subroutine dwrite_I0(ilun,name,idflt,ihave,idiff)
    integer :: ilun         ! unit number
    character*(*) :: name   ! name of variable
    integer :: idflt        ! default value
    integer :: ihave        ! actual value

    integer, intent(out) :: idiff   ! =0: nothing written; >0: writes were done

    character*12 :: zival
    !----------------

    idiff = 0
    if((ihave.ne.idflt_nbips).and.(ihave.ne.idflt)) then
       idiff = 1
       call itrans(ihave,zival)
       write(ilun,*) ' '//trim(name)//' = '//trim(zival)
    endif

  end subroutine dwrite_I0

  subroutine dwrite_I1(ilun,name,idflt,ihave,idiff)
    integer :: ilun         ! unit number
    character*(*) :: name   ! name of variable
    integer, dimension(:) :: idflt        ! default value
    integer, dimension(:) :: ihave        ! actual value

    integer, intent(out) :: idiff   ! =0: nothing written; >0: writes were done

    integer :: ii
    character*12 :: zival,zindx
    !----------------

    idiff = 0

    do ii=1,size(ihave)
       if((ihave(ii).ne.idflt_nbips).and.(ihave(ii).ne.idflt(ii))) then
          idiff=idiff + 1
          call itrans(ii,zindx)
          call itrans(ihave(ii),zival)
          write(ilun,*) ' '//trim(name)//'('//trim(zindx)//') = '//trim(zival)
       endif
    enddo

  end subroutine dwrite_I1

  subroutine dwrite_I2(ilun,name,idflt,ihave,idiff)
    integer :: ilun         ! unit number
    character*(*) :: name   ! name of variable
    integer, dimension(:,:) :: idflt        ! default value
    integer, dimension(:,:) :: ihave        ! actual value

    integer, intent(out) :: idiff   ! =0: nothing written; >0: writes were done

    integer :: ii,jj
    character*12 :: zival,zindx,zjndx
    !----------------

    idiff = 0

    do jj=1,size(ihave,2)
       do ii=1,size(ihave,1)
          if((ihave(ii,jj).ne.idflt_nbips).and.(ihave(ii,jj).ne.idflt(ii,jj))) then
             idiff=idiff + 1
             call itrans(ii,zindx)
             call itrans(jj,zjndx)
             call itrans(ihave(ii,jj),zival)
             write(ilun,*) ' '//trim(name)//'('//trim(zindx)//','// &
                  trim(zjndx)//') = '//trim(zival)
          endif
       enddo
    enddo

  end subroutine dwrite_I2

  subroutine dwrite_D0(ilun,name,idflt,ihave,idiff)
    integer :: ilun         ! unit number
    character*(*) :: name   ! name of variable
    real(fp) :: idflt         ! default value
    real(fp) :: ihave         ! actual value

    integer, intent(out) :: idiff   ! =0: nothing written; >0: writes were done

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

    idiff = 0

    if((ihave.ne.r8dflt_nbips).and.(ihave.ne.idflt)) then
       if(abs(ihave-idflt).gt.1.0e-12_fp*max(abs(ihave),abs(idflt))) then
          idiff=idiff + 1
          write(ilun,1001) ' '//trim(name)//' = ',ihave
       endif
    endif
1001 format(1x,a,1pe22.15)

  end subroutine dwrite_D0

  subroutine dwrite_D1(ilun,name,idflt,ihave,idiff)
    integer :: ilun         ! unit number
    character*(*) :: name   ! name of variable
    real(fp), dimension(:) :: idflt        ! default value
    real(fp), dimension(:) :: ihave        ! actual value

    integer, intent(out) :: idiff   ! =0: nothing written; >0: writes were done

    integer :: ii
    character*12 :: zindx
    !----------------

    idiff = 0

    do ii=1,size(ihave)
       if((ihave(ii).ne.r8dflt_nbips).and.(ihave(ii).ne.idflt(ii))) then
          if(abs(ihave(ii)-idflt(ii)).gt.1.0e-12_fp*max(abs(ihave(ii)),abs(idflt(ii)))) then
             idiff=idiff + 1
             call itrans(ii,zindx)
             write(ilun,1001) ' '//trim(name)//'('//trim(zindx)//') = ',ihave(ii)
          endif
       endif
    enddo
1001 format(1x,a,1pe22.15)

  end subroutine dwrite_D1

  subroutine dwrite_D2(ilun,name,idflt,ihave,idiff)
    integer :: ilun         ! unit number
    character*(*) :: name   ! name of variable
    real(fp), dimension(:,:) :: idflt        ! default value
    real(fp), dimension(:,:) :: ihave        ! actual value

    integer, intent(out) :: idiff   ! =0: nothing written; >0: writes were done

    integer :: ii,jj
    character*12 :: zindx,zjndx
    !----------------

    idiff = 0

    do jj=1,size(ihave,2)
       do ii=1,size(ihave,1)
          if((ihave(ii,jj).ne.r8dflt_nbips).and.(ihave(ii,jj).ne.idflt(ii,jj))) then
             if(abs(ihave(ii,jj)-idflt(ii,jj)).gt.1.0e-12_fp*max(abs(ihave(ii,jj)),abs(idflt(ii,jj)))) then
                idiff=idiff + 1
                call itrans(ii,zindx)
                call itrans(jj,zjndx)
                write(ilun,1001) ' '//trim(name)//'('//trim(zindx)//','// &
                     trim(zjndx)//') = ',ihave(ii,jj)
             endif
          endif
       enddo
    enddo
1001 format(1x,a,1pe22.15)

  end subroutine dwrite_D2

  subroutine dwrite_C0(ilun,name,idflt,ihave,idiff)
    integer :: ilun         ! unit number
    character*(*) :: name   ! name of variable

    character*(*) :: idflt        ! default value
    character*(*) :: ihave        ! actual value

    integer, intent(out) :: idiff   ! =0: nothing written; >0: writes were done

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

    idiff = 0

    if(idflt.ne.ihave) then
       idiff = 1
       write(ilun,*) ' '//trim(name)//' = "'//trim(ihave)//'"'
    endif

  end subroutine dwrite_C0

  subroutine itrans(ival,jchv)
    ! write integer & left justify in output argument

    integer :: ival
    character*12 jchv

    character*12 ichv
    integer :: ic,id

    ichv = ' '
    jchv = ' '
    write(ichv,'(I12)') ival

    id=0
    do ic=1,12
       if(ichv(ic:ic).ne.' ') then
          id=id+1
          jchv(id:id)=ichv(ic:ic)
       endif
    enddo

  end subroutine itrans

  ! PUBLIC:

  integer function inbi_logical(ilogical)

    logical, intent(in) :: ilogical

    if(ilogical) then
       inbi_logical = 1
    else
       inbi_logical = 0
    endif

  end function inbi_logical

end module nbi_pstypes
""")

f_nbipst.close()
f_nbilst.close()
f_nbizone.close()

f_nbinit.close()
f_nbiset.close()
f_nbiget.close()
f_update.close()

f_alloc.close()
f_alloc2.close()
f_alloctr.close()
f_alloctrz.close()
f_alloclst.close()
f_allocm.close()
f_reallocm.close()
f_dalloc.close()
f_spltexpnd.close()
f_allocsplt.close()
f_dallocsplt.close()
f_dalloctr.close()
f_dalloctrz.close()
f_dalloclst.close()

f_statio.close()
f_inp_io.close()
f_out_io.close()
f_asciio.close()
f_pcopy.close()
f_wrdpt.close()

f_nboget.close()
f_nboclr.close()
f_nboldx.close()
f_nboldxf.close()

f_bcast.close()
f_bcast_st.close()
f_bcast_st_get.close()

f_help1.close()
f_help2.close()
f_help3.close()
f_help4.close()

f = open(tmpfile_help1,"r")
help1_lines = f.readlines()
f.close()

f = open(tmpfile_help2,"r")
help2_lines = f.readlines()
f.close()

f = open(tmpfile_help3,"r")
help3_lines = f.readlines()
f.close()

f = open(tmpfile_help4,"r")
help4_lines = f.readlines()
f.close()

for line in help1_lines:
    f_help.write(line)

for line in help2_lines:
    f_help.write(line)

for line in help3_lines:
    f_help.write(line)

for line in help4_lines:
    f_help.write(line)

f_help.close()

#-------------------------------------------------------------------------
print('nbigen.py:  processing completed.')
