test_dynamic_config.F90

Go to the documentation of this file.

! Copyright (c) 2024 The YAC Authors
!
! SPDX-License-Identifier: BSD-3-Clause
 
 
#include "test_macros.inc"
 
#define YAC_RAD (0.01745329251994329576923690768489d0) ! M_PI / 180
 
PROGRAM main
 
  use mpi
  use utest
  use yac
  use, intrinsic :: iso_c_binding, only : c_null_char
 
  IMPLICIT NONE
 
  INTEGER :: rank, global_size, ierror
  INTEGER, PARAMETER :: n_cells(2) = (/32, 16/)
  INTEGER, PARAMETER :: n_corners(2) = (/33, 17/)
  INTEGER, PARAMETER :: cyclic(2) = (/0, 0/)
  DOUBLE PRECISION, PARAMETER :: delta_lon=1., delta_lat=1.
  DOUBLE PRECISION, ALLOCATABLE :: data(:,:)
  DOUBLE PRECISION, ALLOCATABLE :: cell_lon(:), cell_lat(:), corner_lon(:), corner_lat(:)
  INTEGER :: i, comp_id, grid_id, points_id, info, timestep_counter
  INTEGER :: field_1, field_2, field_3, field_4
  CHARACTER(len=YAC_MAX_CHARLEN), PARAMETER :: &
    weight_file_name = "test_dynamic_config.nc"
  CHARACTER(len=YAC_MAX_CHARLEN), PARAMETER :: &
    weight_file_name_dummy = "test_dynamic_config_dummy.nc"
  CHARACTER(len=YAC_MAX_CHARLEN), PARAMETER :: &
    test_config_filename_yaml = "test_dynamic_config.yaml"
  CHARACTER(len=YAC_MAX_CHARLEN), PARAMETER :: &
    test_config_filename_json = "test_dynamic_config.json"
  CHARACTER(len=YAC_MAX_CHARLEN), PARAMETER :: &
    grid_output_filename = "test_dynamic_config_grids.nc"
  LOGICAL :: file_exists
 
  INTERFACE
    SUBROUTINE c_unlink ( path ) bind ( c, name='unlink' )
      use, INTRINSIC :: iso_c_binding, only : c_char
      CHARACTER(KIND=c_char), DIMENSION(*) :: path
    END SUBROUTINE c_unlink
  END INTERFACE
 
  CALL mpi_init(ierror)
  CALL mpi_comm_rank(mpi_comm_world, rank, ierror)
  CALL mpi_comm_size(mpi_comm_world, global_size, ierror)
 
  IF (global_size /= 4) THEN
    WRITE ( * , * ) "Wrong number of processes (should be 4)"
    CALL error_exit
  ENDIF
 
  ALLOCATE(data(n_cells(1), n_cells(2)))
  ALLOCATE(corner_lon(n_corners(1)), corner_lat(n_corners(2)))
  ALLOCATE(cell_lon(n_cells(1)), cell_lat(n_cells(2)))
 
  DO i = 1, n_corners(1)
     corner_lon(i) = (dble(i-1)*delta_lon-180.)*yac_rad
  END DO
  DO i = 1, n_corners(2)
     corner_lat(i) = (dble(i-1)*delta_lat-90.)*yac_rad
  END DO
  DO i = 1, n_cells(1)
     cell_lon(i) = ((dble(i)-0.5)*delta_lon-180.)*yac_rad
  END DO
  DO i = 1, n_cells(2)
     cell_lat(i) = ((dble(i)-0.5)*delta_lat-90.)*yac_rad
  END DO
 
  IF (rank == 0) CALL gen_weight_file()
 
  timestep_counter = 0
 
  IF ( modulo(rank, 2) .eq. 0 ) THEN
     CALL comp1_main()
  ELSE
     CALL comp2_main()
  END IF
 
  IF (rank == 0) THEN
    INQUIRE(file=test_config_filename_yaml, exist=file_exists)
    CALL test(file_exists)
    INQUIRE(file=test_config_filename_json, exist=file_exists)
    CALL test(file_exists)
    INQUIRE(file=grid_output_filename, exist=file_exists)
    CALL test(file_exists)
    CALL c_unlink(trim(grid_output_filename) // c_null_char)
    CALL c_unlink(trim(test_config_filename_json) // c_null_char)
    CALL c_unlink(trim(test_config_filename_yaml) // c_null_char)
    CALL c_unlink(trim(weight_file_name) // c_null_char)
    CALL c_unlink(trim(weight_file_name_dummy) // c_null_char)
  END IF
 
  DEALLOCATE(data, cell_lon, cell_lat, corner_lon, corner_lat)
 
  IF (timestep_counter .NE. 11) stop 2
 
  CALL mpi_finalize(ierror)
 
CONTAINS
 
  SUBROUTINE gen_weight_file()
 
    INTEGER :: yac_id
    INTEGER :: grid_id_out, grid_id_in
    INTEGER :: point_id_in, point_id_out
    INTEGER :: field_id_in, field_id_out
    INTEGER :: interp_stack
 
    CALL yac_finit_comm(mpi_comm_self, yac_id)
    CALL yac_fdef_calendar(yac_proleptic_gregorian)
    CALL yac_fdef_datetime( &
      yac_id, "2000-01-01T00:00:00", "2000-01-01T00:00:10")
    CALL yac_fdef_comp(yac_id, "comp", comp_id)
    CALL yac_fdef_grid("grid1", n_corners, cyclic, &
         & corner_lon, corner_lat, grid_id_out)
    CALL yac_fdef_grid("grid2", n_corners, cyclic, &
         & corner_lon, corner_lat, grid_id_in)
    CALL yac_fdef_points(grid_id_out, n_cells, yac_location_cell, &
         & cell_lon, cell_lat, point_id_out)
    CALL yac_fdef_points(grid_id_in, n_cells, yac_location_cell, &
         & cell_lon, cell_lat, point_id_in)
 
    CALL yac_fdef_field( &
      "out", comp_id, [point_id_out], 1, 1, "1", &
      yac_time_unit_second, field_id_out)
    CALL yac_fdef_field( &
      "in", comp_id, [point_id_in], 1, 1, "1", &
      yac_time_unit_second, field_id_in)
 
    CALL yac_fget_interp_stack_config(interp_stack)
    CALL yac_fadd_interp_stack_config_average( &
      interp_stack, yac_avg_arithmetic, 1)
    CALL yac_fdef_couple(yac_id, &
         "comp", "grid1", "out", &
         "comp", "grid2", "in", &
         "1", yac_time_unit_second, &
         yac_reduction_time_none, interp_stack, &
         src_lag = 0, tgt_lag = 0, &
         weight_file = weight_file_name, &
         mapping_side = 1, &
         scale_factor = 1.0d0, scale_summand = 0.0d0, &
         yaxt_exchanger_name = "irecv_send", &
         collection_indices = (/0/), &
         use_raw_exchange = .false.)
    CALL yac_ffree_interp_stack_config(interp_stack)
 
    CALL yac_fenddef(yac_id)
    CALL yac_ffinalize(yac_id)
  END SUBROUTINE gen_weight_file
 
  SUBROUTINE comp1_main()
 
    IMPLICIT NONE
 
    INTEGER :: field_out, avg_interp
 
    CALL yac_finit()
    ! this component defines the datetime
    CALL yac_fdef_calendar(yac_proleptic_gregorian)
    CALL yac_fdef_datetime("2000-01-01T00:00:00", "2000-01-01T00:00:10")
 
    CALL yac_fset_grid_output_file("grid1", grid_output_filename)
 
    CALL yac_fset_coordinates_check(.false.)
    CALL yac_fset_coordinates_mismatch_is_fatal(.false.)
 
    ! test yac_fpredef_comp:
    CALL yac_fpredef_comp("comp1", comp_id)
    CALL yac_fdef_comp_dummy()
 
    CALL yac_fdef_grid("grid1", n_corners, cyclic, &
         & corner_lon, corner_lat, grid_id)
    CALL yac_fdef_points(grid_id, n_cells, yac_location_cell, &
         & cell_lon, cell_lat, points_id)
 
    CALL yac_fdef_field( &
      "A", comp_id, [points_id], 1, 1, "1", yac_time_unit_second, field_1)
    CALL yac_fdef_field( &
      "B", comp_id, [points_id], 1, 1, "1", yac_time_unit_second, field_2)
    CALL yac_fdef_field( &
      "C", comp_id, [points_id], 1, 1, "1", yac_time_unit_second, field_3)
    CALL yac_fdef_field( &
      "D", comp_id, [points_id], 1, 1, "1", yac_time_unit_second, field_4)
 
    CALL yac_fdef_field( &
      "OUT", comp_id, [points_id], 1, 1, "1", yac_time_unit_second, field_out)
 
    CALL yac_fget_interp_stack_config(avg_interp)
    CALL yac_fadd_interp_stack_config_average( &
      avg_interp, yac_avg_arithmetic, 1)
    CALL yac_fdef_couple( &
         "comp2", "grid2", "4", &
         "comp1", "grid1", "D", &
         "1", yac_time_unit_second, &
         yac_reduction_time_accumulate, avg_interp, &
         src_lag = 0, tgt_lag = 0, &
         weight_file = weight_file_name_dummy, mapping_side = 1, &
         scale_factor = 1.0d0, scale_summand = 0.0d0, &
         yaxt_exchanger_name = "irecv_isend", &
         collection_indices = (/0/), &
         weight_file_on_existing = yac_wgt_on_existing_overwrite)
    CALL yac_ffree_interp_stack_config(avg_interp)
 
    CALL yac_fset_config_output_file( &
      test_config_filename_yaml, yac_config_output_format_yaml, &
      yac_config_output_sync_loc_sync_def)
    CALL yac_fset_config_output_file( &
      test_config_filename_json, yac_config_output_format_json, &
      yac_config_output_sync_loc_enddef, include_definitions=.false.)
 
    CALL yac_fenddef( )
 
    DO WHILE (.true.)
       timestep_counter = timestep_counter + 1
       data = 42.
       CALL yac_fput(field_1, SIZE(data), 1, 1, reshape(data, [SIZE(data), 1, 1]), info, ierror)
       WRITE (0, *) "time of field_1: ", yac_fget_field_datetime(field_1)
       data = 43.
       CALL yac_fput(field_2, SIZE(data), 1, 1, reshape(data, [SIZE(data), 1, 1]), info, ierror)
       data = 44.
       CALL yac_fput(field_3, SIZE(data), 1, 1, reshape(data, [SIZE(data), 1, 1]), info, ierror)
       data = -1.
       CALL yac_fget(field_4, SIZE(data), 1, data, info, ierror)
       IF ((data(1,1) - 40.) > 1e-14) stop 1
       data = 45.
       CALL yac_fput(field_out, SIZE(data), 1, 1, reshape(data, [SIZE(data), 1, 1]), info, ierror)
       IF ( info .EQ. yac_action_put_for_restart) EXIT
    END DO
 
    CALL yac_ffinalize()
 
  END SUBROUTINE comp1_main
 
  SUBROUTINE comp2_main()
    IMPLICIT NONE
    INTEGER :: yac_id, avg_interp, i, field_in(15)
    CHARACTER (LEN=:), ALLOCATABLE :: config
 
    CALL yac_finit(yac_id)
    CALL yac_fdef_calendar(yac_proleptic_gregorian)
    CALL yac_fpredef_comp(yac_id, "comp2", comp_id)
    CALL yac_fdef_comp_dummy(yac_id)
 
    CALL yac_fsync_def(yac_id)
 
    ! define fields after sync_def to tests the sync mechanism
    CALL yac_fdef_grid("grid2", n_corners, cyclic, &
         & corner_lon, corner_lat, grid_id)
    CALL yac_fdef_points(grid_id, n_cells, yac_location_cell, &
         & cell_lon, cell_lat, points_id)
 
    CALL yac_fset_grid_output_file(yac_id, "grid2", grid_output_filename)
 
    CALL yac_fset_coordinates_check(yac_id, .false.)
    CALL yac_fset_coordinates_mismatch_is_fatal(yac_id, .false.)
 
    CALL yac_fdef_field( &
      "1", comp_id, [points_id], 1, 1, "1", yac_time_unit_second, field_1)
    CALL yac_fdef_field( &
      "2", comp_id, [points_id], 1, 1, "1", yac_time_unit_second, field_2)
    CALL yac_fdef_field( &
      "3", comp_id, [points_id], 1, 1, "1", yac_time_unit_second, field_3)
    CALL yac_fdef_field( &
      "4", comp_id, [points_id], 1, 1, "1", yac_time_unit_second, field_4)
 
    CALL yac_fget_interp_stack_config(avg_interp)
    CALL yac_fadd_interp_stack_config_average( &
      avg_interp, yac_avg_arithmetic, 1)
 
    CALL yac_fdef_couple(yac_id, &
         "comp1", "grid1", "A", &
         "comp2", "grid2", "1", &
         "1", yac_time_unit_second, &
         yac_reduction_time_accumulate, avg_interp)
    CALL yac_fdef_couple(yac_id, &
         "comp1", "grid1", "B", &
         "comp2", "grid2", "2", &
         "1", yac_time_unit_second, &
         yac_reduction_time_accumulate, avg_interp)
    CALL yac_fdef_couple(yac_id, &
         "comp1", "grid1", "C", &
         "comp2", "grid2", "3", &
         "1", yac_time_unit_second, &
         yac_reduction_time_accumulate, avg_interp)
 
    CALL yac_ffree_interp_stack_config(avg_interp)
 
    ! check all interpolation methods
    field_in(1) = gen_field_avg(yac_id)
    field_in(2) = gen_field_ncc(yac_id)
    field_in(3) = gen_field_nnn(yac_id)
    field_in(4) = gen_field_dnn(yac_id)
    field_in(5) = gen_field_rbf(yac_id)
    field_in(6) = gen_field_rbf_opts(yac_id)
    field_in(7) = gen_field_conserv(yac_id)
    field_in(8) = gen_field_spmap_yac(yac_id)
    field_in(9) = gen_field_spmap_file(yac_id)
    field_in(10) = gen_field_spmap_ext(yac_id)
    field_in(11) = gen_field_hcsbb(yac_id)
    field_in(12) = gen_field_user_file(yac_id)
    field_in(13) = gen_field_user_file_opts(yac_id)
    field_in(14) = gen_field_fixed(yac_id)
    field_in(15) = gen_field_creep(yac_id)
 
    CALL yac_fenddef( &
      yac_id, yac_yaml_emitter_default_f, config)
    DEALLOCATE(config)
 
    DO WHILE (.true.)
       timestep_counter = timestep_counter + 1
       data = -1.0
       CALL yac_fget(field_1, SIZE(data), 1, data, info, ierror)
       WRITE (0, *) "time of field_1: ", yac_fget_field_datetime(field_1)
       IF ((data(1,1) - 42.) > 1e-14) stop 1
       data = -1.0
       CALL yac_fget(field_2, SIZE(data), 1, data, info, ierror)
       IF ((data(1,1) - 43.) > 1e-14) stop 1
       data = -1.0
       CALL yac_fget(field_3, SIZE(data), 1, data, info, ierror)
       IF ((data(1,1) - 44.) > 1e-14) stop 1
       data = 40.
       CALL yac_fput(field_4, SIZE(data), 1, 1, reshape(data, [SIZE(data), 1, 1]), info, ierror)
       DO i = 1, SIZE(field_in)
        CALL yac_fget(field_in(i), SIZE(data), 1, data, info, ierror)
       END DO
       IF ( info .EQ. yac_action_get_for_restart) EXIT
    END DO
 
    CALL yac_ffinalize(yac_id)
 
  END SUBROUTINE comp2_main
 
  FUNCTION gen_field(yac_id, field_name, interp_stack) RESULT(field_id)
    INTEGER, INTENT(IN) :: yac_id
    CHARACTER(len=*), INTENT(IN) :: field_name
    INTEGER, INTENT(IN) :: interp_stack
    INTEGER :: field_id
 
    CALL yac_fdef_field( &
      field_name, comp_id, [points_id], 1, 1, "1", &
      yac_time_unit_second, field_id)
    CALL yac_fdef_couple( &
      yac_id, "comp1", "grid1", "OUT", "comp2", "grid2", field_name, &
      "1", yac_time_unit_second, yac_reduction_time_none, interp_stack, &
      weight_file_on_existing = yac_wgt_on_existing_overwrite)
    CALL yac_ffree_interp_stack_config(interp_stack)
  END FUNCTION gen_field
 
  FUNCTION gen_field_avg(yac_id)
    INTEGER, INTENT(IN) :: yac_id
    INTEGER :: gen_field_avg
    INTEGER :: interp_stack
    CALL yac_fget_interp_stack_config(interp_stack)
    CALL yac_fadd_interp_stack_config_average( &
      interp_stack, yac_avg_arithmetic, 1)
    gen_field_avg = gen_field(yac_id, "avg", interp_stack)
  END FUNCTION gen_field_avg
 
  FUNCTION gen_field_ncc(yac_id)
    INTEGER, INTENT(IN) :: yac_id
    INTEGER :: gen_field_ncc
    INTEGER :: interp_stack
    CALL yac_fget_interp_stack_config(interp_stack)
    CALL yac_fadd_interp_stack_config_ncc( &
      interp_stack, yac_ncc_avg, 1)
    gen_field_ncc = gen_field(yac_id, "ncc", interp_stack)
  END FUNCTION gen_field_ncc
 
  FUNCTION gen_field_nnn(yac_id)
    INTEGER, INTENT(IN) :: yac_id
    INTEGER :: gen_field_nnn
    INTEGER :: interp_stack
    CALL yac_fget_interp_stack_config(interp_stack)
    CALL yac_fadd_interp_stack_config_nnn( &
      interp_stack, yac_nnn_avg, 3, 0.0d0, 1.0d0)
    gen_field_nnn = gen_field(yac_id, "nnn", interp_stack)
  END FUNCTION gen_field_nnn
 
  FUNCTION gen_field_dnn(yac_id)
    INTEGER, INTENT(IN) :: yac_id
    INTEGER :: gen_field_dnn
    INTEGER :: interp_stack
    CALL yac_fget_interp_stack_config(interp_stack)
    CALL yac_fadd_interp_stack_config_dnn( &
      interp_stack, yac_dnn_dist, yac_dnn_search_distance_fixed, 0.1d0, 1.0d0)
    gen_field_dnn = gen_field(yac_id, "dnn", interp_stack)
  END FUNCTION gen_field_dnn
 
  FUNCTION gen_field_rbf(yac_id)
    INTEGER, INTENT(IN) :: yac_id
    INTEGER :: gen_field_rbf
    INTEGER :: interp_stack
    CALL yac_fget_interp_stack_config(interp_stack)
    CALL yac_fadd_interp_stack_config_rbf(interp_stack)
    gen_field_rbf = gen_field(yac_id, "rbf", interp_stack)
  END FUNCTION gen_field_rbf
 
  FUNCTION gen_field_rbf_opts(yac_id)
    USE yac_core, ONLY : yac_interp_rbf_n_default_f, &
                         yac_interp_rbf_max_search_distance_default_f, &
                         yac_interp_rbf_scale_default_f
    INTEGER, INTENT(IN) :: yac_id
    INTEGER :: gen_field_rbf_opts
    INTEGER :: interp_stack
    CALL yac_fget_interp_stack_config(interp_stack)
    CALL yac_fadd_interp_stack_config_rbf( &
      interp_stack, &
      n=int(yac_interp_rbf_n_default_f), &
      max_search_distance=yac_interp_rbf_max_search_distance_default_f, &
      scale=yac_interp_rbf_scale_default_f)
    gen_field_rbf_opts = gen_field(yac_id, "rbf_opts", interp_stack)
  END FUNCTION gen_field_rbf_opts
 
  FUNCTION gen_field_conserv(yac_id)
    INTEGER, INTENT(IN) :: yac_id
    INTEGER :: gen_field_conserv
    INTEGER :: interp_stack
    CALL yac_fget_interp_stack_config(interp_stack)
    CALL yac_fadd_interp_stack_config_conservative( &
      interp_stack, 1, 1, 1, yac_conserv_destarea)
    gen_field_conserv = gen_field(yac_id, "conserv", interp_stack)
  END FUNCTION gen_field_conserv
 
  FUNCTION gen_field_spmap_yac(yac_id)
    INTEGER, INTENT(IN) :: yac_id
    INTEGER :: gen_field_spmap_yac
    INTEGER :: interp_stack
    CALL yac_fget_interp_stack_config(interp_stack)
    CALL yac_fadd_interp_stack_config_spmap( &
      interp_stack, 0.0d0, 0.0d0, yac_spmap_avg, yac_spmap_none, &
      1.0d0, "" // c_null_char, "" // c_null_char, 0, &
      1.0d0, "" // c_null_char, "" // c_null_char, 0)
    gen_field_spmap_yac = gen_field(yac_id, "spmap_yac", interp_stack)
  END FUNCTION gen_field_spmap_yac
 
  FUNCTION gen_field_spmap_file(yac_id)
    INTEGER, INTENT(IN) :: yac_id
    INTEGER :: gen_field_spmap_file
    INTEGER :: interp_stack
    CALL yac_fget_interp_stack_config(interp_stack)
    CALL yac_fadd_interp_stack_config_spmap( &
      interp_stack, 0.0d0, 0.0d0, yac_spmap_avg, yac_spmap_none, &
      0.0d0, "area.nc" // c_null_char, "src_cell_area" // c_null_char, 0, &
      0.0d0, "area.nc" // c_null_char, "tgt_cell_area" // c_null_char, 0)
    gen_field_spmap_file = gen_field(yac_id, "spmap_file", interp_stack)
  END FUNCTION gen_field_spmap_file
 
  FUNCTION gen_field_spmap_ext(yac_id)
    INTEGER, INTENT(IN) :: yac_id
    INTEGER :: gen_field_spmap_ext
    INTEGER :: interp_stack
    INTEGER :: spmap_overwrite_config_ids(2)
    CALL yac_fget_spmap_overwrite_config_bnd_circle ( &
      0.0d0, 0.0d0, 1.0d0, spmap_overwrite_config_ids(1), &
      spread_distance = 0.5d0)
    CALL yac_fget_spmap_overwrite_config_bnd_circle ( &
      0.0d0, 1.5d0, 1.0d0, spmap_overwrite_config_ids(2), &
      max_search_distance = 0.6d0, weight_type = yac_spmap_dist)
    CALL yac_fget_interp_stack_config(interp_stack)
    CALL yac_fadd_interp_stack_config_spmap( &
      interp_stack, 0.0d0, 0.0d0, yac_spmap_avg, yac_spmap_none, &
      1.0d0, "" // c_null_char, "" // c_null_char, 0, &
      1.0d0, "" // c_null_char, "" // c_null_char, 0, &
      spmap_overwrite_config_ids = spmap_overwrite_config_ids)
    gen_field_spmap_ext = gen_field(yac_id, "spmap_ext", interp_stack)
    CALL yac_ffree_spmap_overwrite_config( &
      spmap_overwrite_config_ids(2))
    CALL yac_ffree_spmap_overwrite_config( &
      spmap_overwrite_config_ids(1))
  END FUNCTION gen_field_spmap_ext
 
  FUNCTION gen_field_hcsbb(yac_id)
    INTEGER, INTENT(IN) :: yac_id
    INTEGER :: gen_field_hcsbb
    INTEGER :: interp_stack
    CALL yac_fget_interp_stack_config(interp_stack)
    CALL yac_fadd_interp_stack_config_hcsbb(interp_stack)
    gen_field_hcsbb = gen_field(yac_id, "hcsbb", interp_stack)
  END FUNCTION gen_field_hcsbb
 
  FUNCTION gen_field_user_file(yac_id)
    INTEGER, INTENT(IN) :: yac_id
    INTEGER :: gen_field_user_file
    INTEGER :: interp_stack
    CALL yac_fget_interp_stack_config(interp_stack)
    CALL yac_fadd_interp_stack_config_user_file( &
      interp_stack, weight_file_name)
    gen_field_user_file = gen_field(yac_id, "user_file", interp_stack)
  END FUNCTION gen_field_user_file
 
  FUNCTION gen_field_user_file_opts(yac_id)
    USE yac, ONLY : yac_file_missing_cont, yac_file_success_stop
    INTEGER, INTENT(IN) :: yac_id
    INTEGER :: gen_field_user_file_opts
    INTEGER :: interp_stack
    CALL yac_fget_interp_stack_config(interp_stack)
    CALL yac_fadd_interp_stack_config_user_file( &
      interp_stack, weight_file_name, &
      on_missing_file=yac_file_missing_cont, &
      on_success=yac_file_success_stop)
    gen_field_user_file_opts = gen_field(yac_id, "user_file_opts", interp_stack)
  END FUNCTION gen_field_user_file_opts
 
  FUNCTION gen_field_fixed(yac_id)
    INTEGER, INTENT(IN) :: yac_id
    INTEGER :: gen_field_fixed
    INTEGER :: interp_stack
    CALL yac_fget_interp_stack_config(interp_stack)
    CALL yac_fadd_interp_stack_config_fixed( &
      interp_stack, -1.0d0)
    gen_field_fixed = gen_field(yac_id, "fixed", interp_stack)
  END FUNCTION gen_field_fixed
 
  FUNCTION gen_field_creep(yac_id)
    INTEGER, INTENT(IN) :: yac_id
    INTEGER :: gen_field_creep
    INTEGER :: interp_stack
    CALL yac_fget_interp_stack_config(interp_stack)
    CALL yac_fadd_interp_stack_config_creep( &
      interp_stack, 0)
    gen_field_creep = gen_field(yac_id, "creep", interp_stack)
  END FUNCTION gen_field_creep
 
  SUBROUTINE error_exit ()
 
    USE mpi, ONLY : mpi_abort, mpi_comm_world
    USE utest
 
    INTEGER :: ierror
 
    CALL test ( .false. )
    CALL stop_test
    CALL exit_tests
    CALL mpi_abort ( mpi_comm_world, 999, ierror )
 
  END SUBROUTINE error_exit
 
END PROGRAM main