Page History

4.2

...

2.1 Subroutine syntax

subroutine name ( <in/out arguments list> [,code_parameters] [,diagnostic_info] )

...

2.2. Arguments list

...

.1. Changes

use euitm_schemas

use ids_schemas

use euitm_routines

use ids_routines

type(type_<cpo_name>) :: cpo 

type (ids_<ids_name>) :: ids 

type(type_<cpo_name>), pointer :: cpoArray(:) <= ARRAY !!

type (ids_<ids_name>) :: ids <== SINGLE OBJ !!!

eval-pkg-config

pkg-config 

eval-pkg-config --cflags --libs ual-ifort

pkg-config --cflags --libs imas-ifort

eval-pkg-config --cflags --libs ual-gfortran

pkg-config --cflags --libs imas-gfortran

type(type_param) :: XML_params

type(ids_parameters_input ) :: XML_params

type type_param    
   ... :: parameters    

   ... :: default_param     

   ... :: schema 
endtype

type ids_parameters_input     

    ... :: parameters_value   

    ... :: parameters_default        

    ... :: schema      

 endtype

use euitm_xml_parser

use imas_xml_parser

call euitm_xml_parse(code_params, nparm, param_list)

call imas_xml_parse(code_params, nparm, param_list)

eval-pkg-config 

pkg-config 

eval-pkg-config --cflags ual-ifort

pkg-config --cflags imas-ifort

eval-pkg-config --cflags ual-gfortran

pkg-config --cflags imas-gfortran

...

...

...

...

...

2.3. Code parameters

...

Argument of type: type_param

...

 type(type_param), intent(in) :: codeparam

integer    ::     outputFlag
character(len=:), pointer   ::

...

...

  diagInfo

type (ids_equilibrium) :: ids <== SINGLE OBJ !!!

integer    ::     outputFlag
character(len=:), pointer   ::    diagInfo

 use imas_xml_parser
 
  type(ids_Parameters_Input),intent(in)   :: code_parameters
  integer, intent(out)                    :: return_status
  type(tree)             :: parameter_list
  type(element), pointer :: temp_pointer
  integer(itm_i4)        :: i, nparm, n_values,j
  character(len = 132)   :: cname
!...  initialisations
  nparm         = 0
  n_values      = 0
  return_status = 0      ! no error
  j             = 0
!-- parse xml-string code_parameters%parameters using W3C XML schema in
!   code_parameters%schema
  call imas_xml_parse(code_parameters, nparm, parameter_list)
!-- assign variables
  temp_pointer => parameter_list%first
  outer: do
    cname = char2str(temp_pointer%cname)   ! necessary for AIX
    select case (cname)
!--   parameters overall
      case ("parameters")
        temp_pointer => temp_pointer%child

...

• parameters - Actual value of the code parameters (instance of coparam/parameters in XML format).
• default_param - Default value of the code parameters (instance of coparam/parameters in XML format).
• schema - Code parameters schema.

...

• (type_param) :: codeparam{{

2.4. Diagnostic info

• arbitrary output diagnostic information
  

  • output / optional

    Code Block
    !---- Diagnostic info ---- integer, intent(out) :: user_out_outputFlag character(len=:), pointer, intent(out) :: user_out_diagnosticInfo

  • outputFlag - indicates if user subroutine was successfully executed

    • outpuflag = 0    - SUCCESS, no action is taken

    • outputFlag > 0  - WARNING, a warning message is displayed, workflow continuue execution

    • outputFlag < 0 - ERROR, actor throws an exception, workflow stops

  • diagnosticInfo - an arbitrary string

2.5. Examples

subroutine noids(input, output)
   integer, intent(in):: input
   integer, intent(out):: output

subroutine equil2dist(equilibriumin, distsourceout)
  use imas_schemas
  implicit none

 !input
 type (type_equilibrium), pointer :: equilibriumin(:)
 !output
 type (type_distsource), pointer :: distsourceout(:)

...

...

        cycle      
!--   parameter classes
!--   individual parameters
      case ("tokamak")
        if (allocated(temp_pointer%cvalue)) &
         call char2num(temp_pointer%cvalue, tokamak)

      case default
        write(0, *) 'ERROR: invalid parameter', cname
        return_status = 1
   

...

...

    exit
    end select
    do
      if (associated(temp_pointer%sibling)) then
        temp_pointer => temp_pointer%sibling
        exit
      end if

...

...

 if 

...

(associated(temp_pointer%parent, parameter_list%first )) &
        exit outer
      if (associated(temp_pointer%parent)) then
        temp_pointer => temp_pointer%parent
      else
        write(0, *) 'ERROR: broken list.'
        return
      end if
    end do
  end do outer

4.2.3

...

Delivery of the user code

The user code should be delivered as a static library.
Please find examples of the simple "

...

Makefile" below:

F90 = $(ITM_INTEL_FC)ifort
COPTS = -g -O0 -assume no2underscore -fPIC -shared-intel

INCLUDES = $(shell eval-pkg-config --cflags ual-$(ITM_INTEL_OBJECTCODE))imas-ifort)

all: equilibrium2distsource.o libequilibrium2distsource

libequilibrium2distsource: equilibrium2distsource.o
        ar -rvs libequilibrium2distsource.a equilibrium2distsource.o

equilibrium2distsource.o: equilibrium2distsource.f90
        $(F90) $(COPTS) -c -o $@ $^ ${INCLUDES} 

clean:
        rm -f *.o *.a