#!/usr/bin/env python3

#--------------------------------------------------------------------
# error handling routines; miscellaneous i/o routines
#------------------------------------------------------

#--------------------------------------------------------------------------
# global items...

from nbigen_global import *

#--------------------------------------------------------------------------

digits = "0123456789"
alphab = "abcdefghijklmnopqrstuvwxyz"
ascii_letters = alphab + alphab.upper()

def nbigen_syntax(section,line):
    print("nbigen_sub: syntax error in section: ", section)
    print("  in line: ", line)
    raise nbigen_error

#------------------------
def nbi_check_num(item,section,line):
    # check that item is a number (all digits)

    if len(item) == 0:
        print('nbi_check_num: missing or zero length item.')
        nbigen_syntax(section,line)
    for char in item:
        if digits.find(char) == -1:
            print('nbi_check_num: expected a non-negative integer number: ',item)
            nbigen_syntax(section,line)

#------------------------
def nbi_check_dim(item,dims,section,line):
    # check that item is a number (all digits)
    if len(item) == 0:
        print('nbi_check_num: missing or zero length item.')
        nbigen_syntax(section,line)
    if item in dims:
        pass
    else:
        for char in item:
            if digits.find(char) == -1:
                print('nbi_check_num: invalid array dimension: ',item)
                nbigen_syntax(section,line)

#------------------------
def nbi_check_odims(dimstr,dims,lims,section,line):
    # check that all array dims are either constants or known dimensions with
    # with known maximum values:
    #   dimstr is the dimension string e.g. "(mj,mibs)"
    #   dims is the list of known dimensions
    #   lims is the list of known maxima (or zeroes when maxima not known)
    #   section,line are strings for error reporting

    adims = dimstr[1:-1].split(",")
    for adim in adims:
        dim = adim.strip().lower()
        nbi_check_dim(dim,dims,section,line)
        dimval = nbi_check_dimo(dim,dims,lims)
        if dimval != 0:
            pass
        else:
            print("nbigen_check_odims: invalid dimension: " + dim)
            print("dimension does not have a known maximal value.")
            nbigen_syntax(section,line)

#------------------------
def nbi_check_dimo(dim,dims,lims):
    #
    #  a passed dimension which is known to be valid (a constant or
    #  a known symbol) has its max value returned, or 0 if unkown.
    #  if dim is "mj", -1 is returned.
    #  if dim is "mib_use",max("mib") is returned.
    #

    if dim == "mj":
        return -1
    elif dim == "mib_use" :
        return lims[dims.index("mib")]
    else:
        if dim in dims:
            indx = dims.index(dim)
            return lims[indx]
        else:
            return int(dim)

#------------------------
def nbi_dimcon(dimstr,dims,lims):
    #
    #  with no error checking, convert a symbolic dimension string into
    #  a max constant dimension string -- for output TYPE declarations;
    #  it has already been checked that dimension max constants are known.
    #

    outstr = "("

    ict = 0
    adims = dimstr[1:-1].split(",")
    ndims = len(adims)

    for adim in adims:
        ict = ict + 1
        zdim = adim.strip().lower()
        ival = nbi_check_dimo(zdim,dims,lims)
        outstr = outstr + repr(ival)
        if ict < ndims:
            outstr = outstr + ","
        else:
            outstr = outstr + ")"

    return outstr

#------------------------
def nbi_check_name(item,section,line):
    # check that items is an alphanumeric name; 1st char must be alphabetic

    if len(item) == 0:
        print('nbi_check_name: missing or zero length item.')
        nbigen_syntax(section,line)
    elif ascii_letters.find(item[0]) == -1:
        print('nbi_check_name: 1st character must be alphabetic: ',item)
        nbigen_syntax(section,line)
    else:
        for char in item[1:]:
            test = ascii_letters + digits + "_"
            if test.find(char) == -1:
                print('char = "',char,'"')
                print('nbi_checkname: alphanumeric characters expected: ',item)
                nbigen_syntax(section,line)

#------------------------
def nbwrite(f, str):

    f.write(str + "\n")

#------------------------
def nbstate_hdr(f, name):

    # header lines for state file i/o subroutines

    nbwrite(f, "subroutine " + name + "(icdf)")
    nbwrite(f, " ")
    nbwrite(f, "  use nbi_com")
    nbwrite(f, "  use ezcdf")
    nbwrite(f, " ")
    nbwrite(f, "  implicit NONE")
    nbwrite(f, " ")
    nbwrite(f, "  integer, intent(in) :: icdf  ! NetCDF file id")
    nbwrite(f, " ")
    nbwrite(f, "  integer :: idm(3),i1,i2,i3,i4")
    nbwrite(f, "  character*4 zvartype")
    nbwrite(f, "  integer, dimension(:), allocatable :: intarr")
    nbwrite(f, " ")

#------------------------
def nbstate_trlr0(f, name):

    nbwrite(f, " ")
    nbwrite(f, "end subroutine " + name)
    nbwrite(f, " ")

#------------------------
def nbstate_trlr(f, name, slist):

    # trailer lines for state file i/o subroutines

    if slist != []:
        nbwrite(f, "  contains")

    if "log2int" in slist:
        nbwrite(f, " ")
        nbwrite(f, "    integer function log2int(ilog)")
        nbwrite(f, "      logical, intent(in) :: ilog")
        nbwrite(f, "      if(ilog) then")
        nbwrite(f, "        log2int=1")
        nbwrite(f, "      else")
        nbwrite(f, "        log2int=0")
        nbwrite(f, "      endif")
        nbwrite(f, "    end function log2int")

    if "int2log" in slist:
        nbwrite(f, " ")
        nbwrite(f, "    logical function int2log(iint)")
        nbwrite(f, "      integer, intent(in) :: iint")
        nbwrite(f, "      if(iint.eq.1) then")
        nbwrite(f, "        int2log=.TRUE.")
        nbwrite(f, "      else")
        nbwrite(f, "        int2log=.FALSE.")
        nbwrite(f, "      endif")
        nbwrite(f, "    end function int2log")

    nbstate_trlr0(f, name)

#------------------------
def nbio_start(f, zclass, suflist):

    # zclass = "state" or "step" for state file or step (update) file
    # respectively

    nbwrite(f, "subroutine nbi_"+zclass+"_write(icdf)")
    nbwrite(f, "  integer, intent(in) :: icdf")
    nbwrite(f, " ")
    nbwrite(f, "  call nbi_"+zclass+"_userdef(icdf)")
    for suffix in suflist:
        nbwrite(f, "  call nbi_"+zclass+"_define" + suffix + "(icdf)")
    nbwrite(f, " ")
    nbwrite(f, "  call nbi_"+zclass+"_userout(icdf)")
    for suffix in suflist:
        nbwrite(f, "  call nbi_"+zclass+"_output" + suffix + "(icdf)")
    nbwrite(f, " ")
    nbwrite(f, "end subroutine nbi_"+zclass+"_write")
    nbwrite(f, " ")
    nbwrite(f, "subroutine nbi_"+zclass+"_read(icdf)")
    nbwrite(f, "  integer, intent(in) :: icdf")
    nbwrite(f, " ")
    nbwrite(f, "  call nbi_"+zclass+"_useread(icdf)")
    for suffix in suflist:
        nbwrite(f, "  call nbi_"+zclass+"_read" + suffix + "(icdf)")
    nbwrite(f, " ")
    nbwrite(f, "end subroutine nbi_"+zclass+"_read")

#------------------------
def nbio_start_ptcl(f, zclass, suflist):

    # zclass = "state" or "step" for state file or step (update) file
    # respectively

    nbwrite(f, "subroutine nbi_"+zclass+"_write_ptcl(icdf)")
    nbwrite(f, "  integer, intent(in) :: icdf")
    nbwrite(f, " ")
    for suffix in suflist:
        nbwrite(f, "  call nbi_"+zclass+"_define" + suffix + "_ptcl(icdf)")
    nbwrite(f, " ")
    for suffix in suflist:
        nbwrite(f, "  call nbi_"+zclass+"_output" + suffix + "_ptcl(icdf)")
    nbwrite(f, " ")
    nbwrite(f, "end subroutine nbi_"+zclass+"_write_ptcl")
    nbwrite(f, " ")
    nbwrite(f, "subroutine nbi_"+zclass+"_read_ptcl(icdf)")
    nbwrite(f, "  integer, intent(in) :: icdf")
    nbwrite(f, " ")
    for suffix in suflist:
        nbwrite(f, "  call nbi_"+zclass+"_read" + suffix + "_ptcl(icdf)")
    nbwrite(f, " ")
    nbwrite(f, "end subroutine nbi_"+zclass+"_read_ptcl")

#------------------------
def nbi_cdfabr(dtype):

    if dtype == "LOGICAL":
        return ["INT",1]
    elif dtype == "INTEGER":
        return ["INT",3]
    elif dtype == "REAL":
        return ["R4",6]
    elif dtype == "REAL(fp)":
        return ["R8",6]
    elif dtype[0:9] == "CHARACTER":
        return ["CHAR",0]
    else:
        print("?nbi_cdfabr:  unexpected datatype:  " + dtype)
        raise nbigen_error

#------------------------
def nbi_idmstr(dims):

    # return an f90 3-element vector constructor

    str = "(/ "

    if len(dims) < 4:
        dimlis = []
        for id in [0,1,2]:
            if id < len(dims):
                dimlis.append(dims[id])
            else:
                dimlis.append("0")
        for dim in dimlis:
            str = str + dim + ", "
        str = str[:-2] + " /)"
    else:
        for dim in dims:
            str = str + dim.strip() + "*"
        str = str[:-1] + ", 0, 0 /)"

    return str

#------------------------
def nbstate_pars1(item,iflag):

    # parse item from input routine, for state file generator code

    dname = item[0]
    dtype = item[1]
    dclass = item[2]
    dimstring = item[4]

    dinfo = nbi_cdfabr(dtype)
    dabbrev = dinfo[0]
    maxdim = dinfo[1]

    if dclass == "scalar":
        if dabbrev == "CHAR":
            dims = ["len(" + dname + ")"]
            ndims = 1
            maxdim = 1
        else:
            dims = []
            ndims = 0
    else:
        # from dimensions string strip off parens & split to list
        dims = dimstring[1:-1].split(",")
        ndims = len(dims)

    if iflag == 1:
        # for id_<name> xplasma id scalars and arrays
        maxdim = 3

    if ndims > maxdim:
        print("?nbigen_sub: statefile code generator limit error:")
        print(" datatype: " + dtype + "  dims: " + dimstring)
        print(" ndims: ",ndims,"   maxdim: ",maxdim)
        raise nbigen_error

    return [dabbrev,dims,ndims,dimstring]

#------------------------
def nbwrite_defvar(dname,dabbrev,dims):

    # write cdfDefVar call for state i/o routine
    str1 = ""
    if dname[0:5] == "svn3v":
        nbwrite(f_statio,"  if(levmod_halo.eq.2) then")
        str1 = "   "

    cstr = nbi_idmstr(dims)

    stri = str1 + "  idm = " + cstr
    nbwrite(f_statio, stri)
    str = str1 + "  call cdfDefVar(icdf, '" + dname + "', idm, '" + dabbrev + "')"
    nbwrite(f_statio,str)
    if dname[0:5] == "svn3v":
        nbwrite(f_statio,"  endif")

#------------------------
def nbwrite_putvar(dname,dtype,ndims,dims,dimstring):

    # write cdfPutVar call for state i/o routine

    usename = dname

    slist = []

    if dtype == "LOGICAL":
        if ndims == 0:
            usename = "log2int(" + dname + ")"
            slist.append("log2int")
        elif ndims == 1:
            usename = "intarr"
            astr = "  allocate(intarr" + dimstring + ")"
            str = "  call nbi_log2int(" + dname + ", intarr, "
            str = str + dims[0] + ")"

            nbwrite(f_statio,astr)
            nbwrite(f_statio,str)
        else:
            print("?nbigen_sub:  state file generator code error.")
            raise nbigen_error

    if ndims < 4:
        str = "  call cdfPutVar(icdf, '" + dname +"', " + usename + ")"
    else:
        if dtype == "REAL(fp)":
            str1 = ""
            if dname[0:5] == "svn3v":
                nbwrite(f_statio,"  if(levmod_halo.eq.2) then")
                str1 = "   "
            cstr = nbi_idmstr(dims)
            cstr = cstr.split(",")
            cstr = cstr[0].strip()
            cstr = cstr[2:].strip()
            str = str1 + "  call nbi_cdf4s(icdf, 'W', '" + dname + "', "
            str = str + dname + ", " + cstr + ", 'R8')"
        else:
            print(" " + dname + " datatype is: " + dtype)
            print("?nbigen_sub: 4d item must have R8 datatype: " + dname)
            raise nbigen_error
    nbwrite(f_statio,str)
    if usename == "intarr":
        strd = "  deallocate(intarr)"
        nbwrite(f_statio, strd)

    if dname[0:5] == "svn3v":
        nbwrite(f_statio,"  endif")

    return slist
#------------------------
def nbwrite_getvar(dname,dtype,dval,ndims,dims,dimstring):

    # write cdfInqVar/cdfGetVar call for state i/o routine

    slist = []

    usename = dname

    if dtype == "LOGICAL":
        if ndims == 0:
            usename = "i1"
        elif ndims == 1:
            usename = "intarr"
            astr = "  allocate(intarr" + dimstring + "); intarr=0"
            nbwrite(f_statio,astr)
        else:
            print("?nbigen_sub:  state file generator code error.")
            raise nbigen_error

    istr = "  call cdfInqVar(icdf, '" + dname + "', idm, zvartype)"
    if ndims < 4:
        if dtype == "REAL(fp)":
            if ndims == 0:
                str= "  call nbi_readCDFR8_0(icdf, '" + dname + "', " + usename
                str = str + ", idm, zvartype)"
            if ndims == 1:
                str= "  call nbi_readCDFR8_1(icdf, '" + dname + "', " + usename
                str = str + ", " + dimstring[1:-1] + ", idm, zvartype)"
            if ndims == 2:
                str= "  call nbi_readCDFR8_2(icdf, '" + dname + "', " + usename
                str = str + ", " + dimstring[1:-1] + ", idm, zvartype)"
            if ndims == 3:
                str= "  call nbi_readCDFR8_3(icdf, '" + dname + "', " + usename
                str = str + ", " + dimstring[1:-1] + ", idm, zvartype)"
        else:
            str = "  call cdfGetVar(icdf, '" + dname +"', " + usename + ")"
            if usename == "i1":
                str = str + "; " + dname + " = int2log(i1)"
                slist.append("int2log")
    else:
        if dtype != "REAL(fp)":
            print("?nbigen_sub:  state file generator code error:")
            print(" logical or integer array of rank > 3 not supported.")
            raise nbigen_error

        cstr = nbi_idmstr(dims)
        cstr = cstr.split(",")
        cstr = cstr[0].strip()
        cstr = cstr[2:].strip()
        str = "  call nbi_cdf4s(icdf, 'R', '" + dname + "', "
        str = str + dname + ", " + cstr + ", zvartype)"

    nbwrite(f_statio,"  idm = (/ -1, -1, -1 /)")
    if dname[0:5] == "svn3v":
        nbwrite(f_statio,"  if(levmod_halo.eq.2) then")
        nbwrite(f_statio,"  "+istr)
        nbwrite(f_statio,"  endif")
    else:
        nbwrite(f_statio,"  "+istr)

    nbwrite(f_statio,"  if(idm(1).ne.-1) then")
    nbwrite(f_statio,"  " + str)
    nbwrite(f_statio,"  else")
    strw = "    write(nonlin,*) ' %variable not in state file: "
    if dname[0:5] == "svn3v":
        strw1 = strw + dname.upper() + "; ignore.'"
        strw = "    write(nonlin,*) ' % or levmod_halo.ne.2' "
    else:
        strw1 = strw + dname.upper() + "; default value set.'"
        strw = "    " + dname + " =  " + dval

    nbwrite(f_statio,strw1)
    if dname.lower() == "debug_mpi":
        strw = "#ifdef __MPI"
        nbwrite(f_statio,strw)
        strw = "    " + dname + " =  nltest_output"
        nbwrite(f_statio,strw)
        strw = "#else"
        nbwrite(f_statio,strw)
        strw = "    " + dname + " =  .FALSE."
        nbwrite(f_statio,strw)
        strw = "#endif"
        nbwrite(f_statio,strw)
    else:
        nbwrite(f_statio,strw)

    nbwrite(f_statio,"  endif")

    if usename == "intarr":
        str = "  call nbi_int2log(intarr, " + dname + ", "
        str = str + dims[0] + ")"
        strd = "  deallocate(intarr)"
        nbwrite(f_statio,str)
        nbwrite(f_statio, strd)

    return slist

#------------------------
def nbparse_item(section,line):

    #---------------------------
    # parse an item
    # [<pllinfo>%]<decl>  <name>[(dims)]=<default-value>

    pllinfo = []

    tmpp = line.split("%")
    if len(tmpp) > 2 or len(tmpp) < 1:
        print(" too many % delimiters...")
        nbigen_syntax(section,line)
    elif len(tmpp) == 2:
        # pllinfo present
        lina=tmpp[1].strip()
        tmpq=tmpp[0].split(",")
    else:
        # pllinfo absent
        lina=tmpp[0].strip()
        tmpq=[]

    tmp = lina.split(" ",1)
    if len(tmp) <  2:
        nbigen_syntax(section,line)

    decl = tmp[0].upper()
    dname = tmp[1].strip()

    namval = dname.split("=")

    if len(namval) > 2 or len(namval) < 1:
        nbigen_syntax(section,line)
    elif len(namval) == 2:
        lhs = namval[0]
        rhs = namval[1]
    else:
        lhs = namval[0]
        rhs = ""

    indpar = lhs.find("(")
    if indpar > -1:
        name = lhs[:indpar].strip()
        dims = lhs[indpar:].strip()  # save dimension info

    else:
        name = lhs.strip()
        dims = ""

    nbi_check_name(name,section,line)

    #  deal with parallel designator info...

    if tmpq != []:
        if decl[0:2] != "DA":
            print("parallel designator but data type not DA: ",decl[0:2])
            nbigen_syntax(section,line)

    for item in tmpq:
        tmpr = item.split(":")
        if len(tmpr) > 2 or len(tmpr) < 1:
            print("too many : delimiters")
            print("error in parallel section designator, left of % sign")
            nbigen_syntax(section,line)
        pllname = tmpr[0].strip().lower()
        nbi_check_name(pllname,section,line)
        dimlist = dims[1:-1].split(",")
        if len(tmpr) == 1:
            # find dimension to be used to identify arrays sections being
            # summed...
            idim=0
            ict=0
            for dimname1 in dimlist:
                ict = ict + 1
                dimname = dimname1.strip().lower()
                if dimname == "mibs" or dimname == "mibs_use" or dimname == "mtrk0" or dimname == "mib"  or dimname == "mib_use" or dimname == "mireact" or dimname == "mlost_data":
                    if idim > 0:
                        print("ambiguous: dimension to be fixed during parallel sums")
                        nbigen_syntax(section,line)
                    else:
                        idim = ict
            if idim == 0:
                print("missing: dimension to be fixed during parallel sums")
                nbigen_syntax(section,line)
            pllinfo.append([pllname,idim])
        else:
            idim = int(tmpr[1].strip())
            if idim < 0:
                print("negative dimension specifier left of % sign")
                nbigen_syntax(section,line)
            elif idim == 0:
                # zero designator -- no matches to "mibs" etc. allowed...
                ict=0
                for dimname1 in dimlist:
                    ict = ict + 1
                    dimname = dimname1.strip().lower()
                    if dimname == "mibs" or dimname == "mib" or dimname == "mib_use" or dimname == "mireact":
                        print("dimension #",ict," inconsistent with :0 designator")
                        nbigen_syntax(section,line)
            else:
                # non-zero designator
                ict=0
                iok=0
                for dimname1 in dimlist:
                    ict = ict + 1
                    if idim == ict:
                        dimname = dimname1.strip().lower()
                        if dimname == "mibs" or dimname == "mib" or dimname == "mib_use" or dimname == "mireact":
                            iok=1
                if iok==0:
                    if idim > ict:
                        print("indicated dimension #",idim," exceeds number available: ",ict)
                        nbigen_syntax(section,line)
                    else:
                        print("indicated dimension #",idim," not of expected type.")
                        nbigen_syntax(section,line)
            pllinfo.append([pllname,idim])

    return [pllinfo,decl,name,dims,rhs]

#-----------------------------
def nbparse_decl(section,line,decl,dims):

    # parse decl
    # {D|R|I|L|C*n}[A][X|M]
    #  D->REAL(fp) R->REAL I->INTEGER L->LOGICAL C*n-> CHARACTER*n
    #           (R no longer supported)
    #
    #  A means ARRAY; if no A it is a scalar
    #
    #  X means extensible, as in a list (input only)
    #  M means updatable (input only)
    #  ~ & | & ^ & @ are output modes... (output only)
    #  S means needed in state file (automatic for input)
    #  if neither X nor M then item is set once only at start of run

    ilast = len(decl)-1
    zmode = decl[ilast]
    if zmode == "N":
        zmode = decl[ilast-1]+zmode
    if zmode == "X" or zmode == "M" or zmode == "S" or \
           zmode == "~" or zmode == "|" or zmode == "^" or zmode == "@":
        decl = decl[0:ilast]
        if decl[-1:] == "S":
            zmode = "S" + zmode
            decl = decl[0:-1]
    elif zmode == "SN":
        decl = decl[0:ilast-1]
    else:
        zmode = " "

    ilast = len(decl)-1
    if decl[ilast] == "A":
        atype = "array"
        decl = decl[0:ilast]
        if dims == "":
            print("nbigen_sub:  array dimensions missing.")
            nbigen_syntax(section,line)
    else:
        atype = "scalar"
        if dims != "":
            print("nbigen_sub:  scalar with array dimensions.")
            nbigen_syntax(section,line)

    if decl == "D":
        dtype = "REAL(fp)"
    elif decl == "R":
        dtype = "REAL"
        print('nbigen_sub: "R" variables no longer accepted.')
        nbigen_syntax(section,line)
    elif decl == "I":
        dtype = "INTEGER"
    elif decl == "L":
        dtype = "LOGICAL"
    elif decl[0:2] == "C*":
        isize = decl[2:]
        nbi_check_num(isize,section,line)
        dtype = "CHARACTER*" + isize
        if atype == "array":
            print("nbigen_sub: type declarator error: " + decl + " python3 script cannot handle arrays of character*n at this time.")
            nbigen_syntax(section,line)

    else:
        print("nbigen_sub: type declarator error: " + decl)
        nbigen_syntax(section,line)

    return [dtype,atype,zmode]

def nbcheck_prof(dtype,name,dims):

    #  check for profile output:
    #  look for "MJ" as one of the dimensions; dtype must be REAL or REAL(fp)
    #  if present...

    #  if profile output is present, create xplasma id variable or array
    #     <profile_name>(mj) -> one profile, scalar id variable
    #     <profile_name>([dims,]mj[,dims]) -> multiple profiles, id array

    ioname = ""
    iodims = ""

    ioflag = 0
    ictr = 0
    jctr = 0
    kctr = 0

    dimlist = dims[1:-1].split(",")
    for adim in dimlist:
        ictr = ictr + 1
        dim = adim.strip().upper()
        if dim == "MJ":
            ioflag = ictr
        else:
            jctr = jctr + 1
            if dim == "MIB" or dim == "MIB_USE" or dim == "MIBS":
                kctr = kctr + 1

    if jctr > 3:
        print("nbcheck_prof: too many dimensions in output structure:")
        print(dtype + " " + name + " dimensions: " + dims)
        raise nbcheck_prof_error

    if kctr > 1:
        print("nbcheck_prof: MIB (MIB_USE) and MIBS cannot both be used in a single structure:")
        print(dtype + " " + name + " dimensions: " + dims)
        raise nbcheck_prof_error

    if ioflag > 0:

        if dtype != "REAL" and dtype != "REAL(fp)":
            print("nbcheck_prof: profile types must have R or D elements.")
            ioname = "ERROR"
        else:
            ioname = "io_" + name

            if len(dimlist) > 1:
                iodims = "("

                ict = 0
                ic2 = 0

                for adim in dimlist:
                    ict = ict + 1
                    dim = adim.strip()
                    if ict != ioflag:
                        ic2 = ic2 + 1
                        iodims = iodims + dim
                        if ic2 < ictr-1:
                            iodims = iodims + ","
                        else:
                            iodims = iodims + ")"

    return [ioname,iodims]

#------------------------
def nbocopy_array(f_out,ioname,iodims,scale_fac):

    gdims = "("
    iodiml = iodims[1:-1].split(",")
    ilen = len(iodiml)
    icur = 0
    for adim in iodiml:
        icur = icur + 1
        bdim = adim.strip().lower()
        gdims = gdims + "1:" + bdim
        if icur < ilen:
            gdims = gdims + ","
        else:
            gdims = gdims + ")"

    nbwrite(f_out,"  zblock%" + ioname + " = 0")
    str = "  zblock%" + ioname + gdims + " = "
    str = str + ioname + gdims
    if scale_fac != "":
        str = str + "*" + scale_fac

    nbwrite(f_out,str)

#------------------------

#------------------------
def ihelp_start( f, name, jset, jmod):

    nbwrite( f, "4 nbitype_" + name)
    nbwrite( f, "    use nbi_types")

    str = "    type(nbitype_" + name + ") :: z" + name
    str = str + "   ! instantiate object"
    nbwrite( f, str)
    nbwrite( f, "    integer :: ierr               ! status code, 0=OK")
    nbwrite( f, " ")

    str = "    call nbi_init_" + name + "(z" + name
    str = str + ")     ! set defaults"
    nbwrite( f, str)
    nbwrite( f, "       [...user code...]          ! modify elements...")

    if jset == "TRUE":
        if name != "times" and name != "profiles":
            nbwrite( f, " ")
            nbwrite( f, "    ! this can only be done ONCE:")
            str = "    call nbi_set_" + name + "(z" + name
            str = str + ",ierr) ! send to NUBEAM"
            nbwrite( f, str)
            nbwrite( f, "    if(ierr.ne.0) [...handle error...]")
        else:
            nbwrite( f, "    ! (nbi_set method not recommended)")

    if jset == "FALSE":
        nbwrite( f, " ")
        nbwrite( f, "    ! set integer values to match the number")
        nbwrite( f, "    ! corresponding list elements to *add* on this call")
        nbwrite( f, " ")
        str = "    call nbi_add_" + name + "(z" + name
        str = str + ",ierr) ! append to NUBEAM list(s)"
        nbwrite( f, str)
        nbwrite( f, "    if(ierr.ne.0) [...handle error...]")


    nbwrite( f, " ")
    nbwrite( f, "        ... ... ... ... ")
    str = "    call nbi_get_" + name + "(z" + name
    nbwrite( f, " ")
    if name == "dims":
        str = str + ",ierr) ! retrieve from NUBEAM"
    else:
        str = str + ")      ! retrieve from NUBEAM"
    nbwrite( f, str)
    if name == "dims":
        nbwrite( f, "    if(ierr.ne.0) [...handle error...]")
        nbwrite( f, "    ! note: most nbi_get methods do not return ierr.")
        nbwrite( f, "    !       nbi_get_dims can be used to check if")
        nbwrite( f, "    !       NUBEAM dimensions have been set.")

    if jmod == "TRUE":
        nbwrite( f, " ")
        if name != "times" and name != "profiles":
            nbwrite( f,
                     "    ! the following should be preceeded by a nbi_get call.")
            nbwrite( f, "    ! only items marked as updatable are affected")
            nbwrite( f, "    ! inside NUBEAM by this call (see element description)")
        else:
            nbwrite( f, "    ! usually, all elements are reset every timestep:")
        nbwrite( f, " ")
        nbwrite( f, "       [...user code...]          ! modify elements...")
        str = "    call nbi_update_" + name + "(z" + name
        str = str + ")   ! send to NUBEAM"
        nbwrite( f, str)

    nbwrite( f, " ")
    nbwrite( f, "members of nbitype_" + name + " data type:")
    nbwrite( f, " ")


#------------------------
def ohelp_start( f, name):

    nbwrite( f, "4 nbotype_" + name)
    nbwrite( f, "    use nbi_types")

    str = "    type(nbotype_" + name + ") :: z" + name
    str = str + "   ! instantiate object"
    nbwrite( f, str)

    nbwrite( f, " ")
    nbwrite( f, "    ! get NUBEAM calculation results:")
    str = "    call nbo_get_" + name + "(z" + name + ")"
    nbwrite( f, str)
    nbwrite( f, " ")
    nbwrite( f, "members of nbotype_" + name + " data type:")
    nbwrite( f, " ")

#------------------------
def nbtype_dval(dtype):

    if dtype == "INTEGER":
        dval = "0"
        type_abbrev = "I"
    elif dtype == "REAL":
        dval = "zero"
        type_abbrev = "R"
    elif dtype == "REAL(fp)":
        dval = "zero"
        type_abbrev = "D"
    elif dtype == "LOGICAL":
        dval = ".FALSE."
        type_abbrev = "L"
    elif dtype[0:4] == "CHAR":
        dval = "' '"
        type_abbrev = "C"
    else:
        print(" ? nbtype_dval: internal error, unrecognized type: " + dtype)
        raise(nbigen_error)

    return [dval,type_abbrev]

def wr_alloc_check(f, subname, array_name, istart):

    # write exit clause on 1st array encountered (istart=0)

    if istart > 0:
        return istart

    else:
        istart=1
        nbwrite( f, "  if(allocated(" + array_name + ")) then")
        nbwrite( f, "     write(nonlin,*) '%" + subname + ": " +
                 array_name + " already allocated; exiting.'")
        nbwrite( f, "     return")
        nbwrite( f, "  endif")
        nbwrite( f, " ")

        return istart

def wr_spltexpnd(f, array_name, array_type):

        if array_type.upper() == "I":
            nbwrite( f, "  itmp(1:minbs_save) = " + array_name + "(1:minbs_save)")
        elif array_type.upper() == "R":
             nbwrite( f, "  tmp(1:minbs_save) = " + array_name + "(1:minbs_save)")

        nbwrite( f, "  if(allocated(" + array_name + ")) deallocate(" + array_name + ")")
        nbwrite( f, "  allocate(" + array_name + "(1:minbs_expnd))")

        if array_type.upper() == "I":
            nbwrite( f,"  " +  array_name + " = 0")
            nbwrite( f,"  " +  array_name + "(1:minbs_save) = itmp(1:minbs_save) ")
        elif array_type.upper() == "R":
            nbwrite( f,"  " +   array_name + " = zero")
            nbwrite( f,"  " +   array_name + "(1:minbs_save) = tmp(1:minbs_save) ")




def wr_alloc_check_track(f, subname, array_name, istart):

    # starting logic for track array allocation

    if istart > 0:
        return istart

    else:
        istart=1
        nbwrite( f, "  if(mibs_use.le.0) then")
        nbwrite( f, "     call warnLog(' nbi_alloc_track: mibs_use.le.0')")
        nbwrite( f, "     call nbi_dalloc_track")
        nbwrite( f, "     return")
        nbwrite( f, "  endif")
        nbwrite( f, " ")
        nbwrite( f, "  ia=.TRUE.")
        nbwrite( f, "  if(allocated(" + array_name + ")) then")
        nbwrite( f, "     if(size(" + array_name + ",1).eq.mdep0) then")
        nbwrite( f, "        if(size(" + array_name + ",2).eq.mibs_use) then")
        nbwrite( f, "           ia=.FALSE.")
        nbwrite( f, "        endif")
        nbwrite( f, "     endif")
        nbwrite( f, "  endif")
        nbwrite( f, " ")
        nbwrite( f, "  if(ia) call nbi_dalloc_track")
        nbwrite( f, " ")
        nbwrite( f, "  ! arrays are set to zero regardless of (ia) setting.")
        nbwrite( f, " ")

        return istart

def wr_alloc_check_track_zone(f, subname, array_name, istart):

    # starting logic for track array allocation

    if istart > 0:
        return istart

    else:
        istart=1
        nbwrite( f, "  if(jsize.le.0) then")
        nbwrite( f, "     call warnLog(' nbi_alloc_track_zone: jsize.le.0')")
        nbwrite( f, "     call nbi_dalloc_track_zone")
        nbwrite( f, "     return")
        nbwrite( f, "  endif")
        nbwrite( f, "  ia=.TRUE.")
        nbwrite( f, "  if(allocated(" + array_name + ")) then")
        nbwrite( f, "     if(size(" + array_name + ").eq.jsize) then")
        nbwrite( f, "        ia=.FALSE.")
        nbwrite( f, "     else")
        nbwrite( f, "        call nbi_dalloc_track_zone")
        nbwrite( f, "     endif")
        nbwrite( f, "  endif")
        nbwrite( f, " ")
        nbwrite( f, "  ! arrays are set to zero regardless of (ia) setting.")
        nbwrite( f, " ")

        return istart

def wr_expand_track_zone(f, subname, array_name, istart):

    # starting logic for track array allocation

    if istart > 0:
        return istart

    else:
        istart=1
        nbwrite( f, "  if(mtrk0.le.0) then")
        nbwrite( f, "     call warnLog(' nbi_expand_track_zone: mtrk0.le.0')")
        nbwrite( f, "     call nbi_dalloc_track_zone")
        nbwrite( f, "     mtrk0_prev = 0 ")
        nbwrite( f, "     return")
        nbwrite( f, "  endif")
        nbwrite( f, "  ")
        nbwrite( f, "  if(allocated(" + array_name + ")) then")
        nbwrite( f, "     if(mtrk0_prev.eq.mtrk0) then")
        nbwrite( f, "        return !no new zone added")
        nbwrite( f, "     else if((mtrk0_prev.gt.mtrk0).OR.(mtrk0_prev.le.0)) then")
        nbwrite( f, "        mtrk0_maxsize=max(mtrk0_maxsize,mtrk0_prev)")
        nbwrite( f, "        mtrk0_maxsize=max(mtrk0_maxsize,mtrk0)")
        nbwrite( f, "        mtrk0_maxsize=max(mtrk0_maxsize,size(" + array_name + "))")
        nbwrite( f, "        call nbi_alloc_track_zone(mtrk0_maxsize)! new step starts")
        nbwrite( f, "        mtrk0_prev = mtrk0")
        nbwrite( f, "        return")
        nbwrite( f, "     endif")
        nbwrite( f, "  else")
        nbwrite( f, "     mtrk0_maxsize=max(mtrk0_maxsize,mtrk0_prev)")
        nbwrite( f, "     mtrk0_maxsize=max(mtrk0_maxsize,mtrk0)")
        nbwrite( f, "     call nbi_alloc_track_zone(mtrk0_maxsize)! arrays not allocated yet")
        nbwrite( f, "     mtrk0_prev = mtrk0")
        nbwrite( f, "     return")
        nbwrite( f, "  endif")
        nbwrite( f, " ")

        nbwrite( f, "  if(mtrk0.le.mtrk0_maxsize) then")
        nbwrite( f, "     if(kdep0.eq.mdep0) then")
        nbwrite( f, "        write(nonlin,*) '% nbi_expand_track zone: used ',mtrk0,' out of ',mtrk0_maxsize,' available.'")
        nbwrite( f, "     endif")
        nbwrite( f, "     mtrk0_prev = mtrk0")
        nbwrite( f, "     return  ! enough space is available")
        nbwrite( f, "  else")
        nbwrite( f, "     iblks = mtrk0_maxsize/mtrk0_blksize ! old #blks ")
        nbwrite( f, " ")
        nbwrite( f, "     ! new #, mdep0.ge.kdep0  --  generalized for multi species in bugfix")
        nbwrite( f, "     ! DMC June 2011")
        nbwrite( f, " ")
        nbwrite( f, "     iblks = (iblks*mdep0*maxval(mibs2use))/kdep0sum + 1")
        nbwrite( f, " ")
        nbwrite( f, "     mtrk0_maxsize = iblks*mtrk0_blksize ! new maxsize ")
        nbwrite( f, "     write(nonlin,*) '% nbi_expand_track_zone, expanding to: ',mtrk0_maxsize")
        nbwrite( f, "  endif")

        nbwrite( f, " ")
        str = "  if(allocated(tmp)) deallocate(tmp)"
        nbwrite(f,str)
        str = "  allocate(tmp(mtrk0_prev))"
        nbwrite(f,str)
        nbwrite( f, " ")

        return istart
