#!/bin/bash
# This script pre-processes the Fortran source code for g95 and Absoft af95.
# 1. They do not recognize the `back` keyword in `min/maxloc`, which is available since F2008.
# 2. They do not support allocatable characters (variable length strings), which is F2003.
# 3. af95 does not support `error stop`, which is F2003.

DIR="$(realpath "$1")"
GETACTF90="getact.f90"
GETACT="$DIR/lincoa/$GETACTF90"
PREPROCF90="preproc.f90"
PREPROC="$DIR/common/$PREPROCF90"
LINALGF90="linalg.f90"
LINALG="$DIR/common/$LINALGF90"
CMN_FPRINTF90="fprint.f90"
CMN_FPRINT="$DIR/common/$CMN_FPRINTF90"
MEX_FPRINTF90="fprint.F90"
MEX_FPRINT="$DIR/common/$MEX_FPRINTF90"
DEBUGF90="debug.F90"
DEBUG="$DIR/common/$DEBUGF90"
NOISEF90="noise.f90"
NOISE="$DIR/testsuite/$NOISEF90"
FMXAPIF90="fmxapi.F90"
FMXAPI="$DIR/$FMXAPIF90"
MEMORYF90="memory.F90"
MEMORY="$DIR/common/$MEMORYF90"
STRINGF90="string.f90"
STRING="$DIR/common/$STRINGF90"
MESSAGEF90="message.f90"
MESSAGE="$DIR/common/$MESSAGEF90"

if ! basename "$DIR" | grep -q ".test\|test." || ! [[ -d "$DIR" ]] ; then
    printf "\n%s is not a testing directory.\n\nExit.\n\n" "$DIR"
    exit 1
fi

if [[ -f "$GETACT" ]] ; then
    sed -i "s/,\s*back\s*=\s*\.true\.//" "$GETACT"
fi

for FILE in "$PREPROC" "$LINALG" "$CMN_FPRINT" "$MEX_FPRINT" "$DEBUG" "$NOISE" "$FMXAPI" ; do
    if [[ -f "$FILE" ]] ; then
        sed -i "s/character(len=:), allocatable/character(len=1024)/" "$FILE"
        sed -i "/character(len=\*), parameter :: newline/d" "$FILE"
        sed -i "s|newline|achar(10)|g" "$FILE"
    fi
done

if [[ -f "$STRING" ]] ; then
    sed -i "s/character(len=:), allocatable/character(len=1024)/" "$STRING"
    sed -i "/LEN(S) <= MAX_NUM_STR_LEN/d" "$STRING"
    sed -i "s/write (str, sformat) x/write(*,*) sformat; write (str, *) x/" "$STRING"
    sed -i "/character(len=\*), parameter :: newline/d" "$STRING"
    sed -i "s|newline|achar(10)|g" "$STRING"
fi

if [[ -f "$MEMORY" ]] ; then
    sed -i "s/character(len=:), allocatable/character(len=1024)/" "$MEMORY"
    sed -i "/allocate (character/d" "$MEMORY"
    sed -i "/call validate(allocated(x), 'X is allocated', srname)/d" "$MEMORY"
    sed -i "s/integer :: alloc_status/integer :: alloc_status = 0/" "$MEMORY"
fi

# message.f90 does not work due to the changes to string.f90, especially to real2str_vector.
(cd "$DIR" && grep -R 'call .*msg' | sed 's|:.*$||' | grep -v 'debug.F90\|fmxapi.F90' | xargs sed -i "s|call .*msg.*$|write(*,*) solver|" && cd - || exit 1) > /dev/null
(cd "$DIR" && grep -R 'use.*message_mod' | sed 's|:.*$||' | xargs sed -i "/use.*message_mod/d" && cd - || exit 1) > /dev/null
printf "module message_mod \n end module message_mod" > "$MESSAGE"

if [[ -f "$DEBUG" ]] ; then
    sed -i "s|^\s*error stop.*$|stop|" "$DEBUG"
fi

for SOL in cobyla uobyqa newuoa bobyqa lincoa ; do
    FILE="$DIR/test_$SOL.f90"
    if [[ -f $FILE ]] ; then
        sed -i "s|character(len=:), allocatable|character(len=1024)|g" "$FILE"
        sed -i "/safealloc(testdim.*$/d" "$FILE"
        # af95 does not support internal subroutines as arguments.
        sed -i "s|subroutine test_solver(\(.*\))\s*$|subroutine test_solver(\1)\n use, non_intrinsic :: recursive_mod, only : recursive_fun1|" "$FILE"
        sed -i "s|call $SOL(recursive_fun2|call $SOL(recursive_fun1|" "$FILE"
    fi
done

if [[ -d "$DIR"/lincoa ]] ; then
    for FILE in "$DIR"/lincoa/* ; do
        if [[ -f "$FILE" ]] ; then
            sed -i "s|count(xl > -REALMAX)|size(xl)|" "$FILE"
            sed -i "s|count(xu < REALMAX)|size(xu)|" "$FILE"
        fi
    done
    sed -i -e '/amat = reshape(shape=shape(amat)/,+3d' "$DIR"/lincoa/lincoa.f90
    sed -i '/idmat/d' "$DIR"/lincoa/lincoa.f90
fi


exit 0
