psmile_scc.F90

Go to the documentation of this file.

!------------------------------------------------------------------------
! Copyright 2006-2010, CERFACS, Toulouse, France.
! All rights reserved. Use is subject to OASIS4 license terms.
!-----------------------------------------------------------------------
!BOP
!
! !MODULE PSMILe_scc
MODULE PSMILe_scc

! !PUBLIC TYPES
  USE PRISM_Constants
  USE PSMILe_common

  IMPLICIT NONE

! !DESCRIPTION
! This module gathers the routines used to extract the information form SCC
!
! !REVISED HISTORY
!   Date        Programmer     Description
! ----------    ----------     -----------
! 13/05/2003   Declat-Valcke    Creation
!
!EOP
!----------------------------------------------------------------------
! $Id: psmile_scc.F90 2687 2010-10-28 15:15:52Z coquart $
! $Author: coquart $
!----------------------------------------------------------------------
!
!  Global variable
SAVE
! Handle to open SCC XML document
  INTEGER ig_SCC_handle
!
!======================================================================
!
! 
CONTAINS

!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
! open the scc.xml file
!
  SUBROUTINE open_scc_file (il_error)

    INTEGER, INTENT (Out) :: il_error

    INTEGER :: sasa_c_read_file  ! external C function

    ig_SCC_handle = sasa_c_read_file ('scc.xml', 7)
    if (ig_SCC_handle .eq. -1) then
       il_error = 1
    else
       il_error = 0
    endif

  END SUBROUTINE open_scc_file

!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
! close the scc.xml file
!
  SUBROUTINE close_scc_file ()

    INTEGER :: sasa_c_close  ! external C function
    INTEGER :: il_err

    il_err = sasa_c_close (ig_SCC_handle)

  END SUBROUTINE close_scc_file

!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
! Does the simulation use the spawn feature or not ?
!

  SUBROUTINE get_execution_mode (execution_mode, error)

    INTEGER, INTENT (Out) :: execution_mode ! (1 : not_spawn | 2 : spawn)
    INTEGER, INTENT (Out) :: error

    INTEGER :: sasa_c_get_attri_1st_level  ! external C function
    INTEGER :: sasa_c_convert_char2int  ! external C function

    CHARACTER(LEN=max_name) :: cla_char
    CHARACTER(LEN=max_name) :: cla_execution_mode
    INTEGER                 :: il_length

    error = sasa_c_get_attri_1st_level( ig_SCC_handle, &
       'experiment', 0, 'start_mode', cla_char, il_length)
    cla_execution_mode = ' '
    cla_execution_mode = cla_char(1:il_length)
    execution_mode = sasa_c_convert_char2int(TRIM(cla_execution_mode))

  END SUBROUTINE get_execution_mode

!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
! How many pes for the driver/transformer
!

  SUBROUTINE get_transformer_pes (transf_pes, error)

    INTEGER, INTENT (Out) :: transf_pes
    INTEGER, INTENT (Out) :: error

    INTEGER :: sasa_c_get_element_2nd_level_i

! number of transformer pes
    error = &
       sasa_c_get_element_2nd_level_i (ig_SCC_handle, &
       'experiment', 0, 'driver', 0, 'nbr_procs', 0,  &
       transf_pes)

  END SUBROUTINE get_transformer_pes

!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
! Collect the dates used in the simulation
!

  SUBROUTINE get_dates ( experiment_start_date, &
     experiment_end_date,   &
     run_start_date,        &
     run_end_date,          &
     error)

    TYPE(PRISM_Time_Struct), INTENT (InOut) :: experiment_start_date
    TYPE(PRISM_Time_Struct), INTENT (InOut) :: experiment_end_date 
    TYPE(PRISM_Time_Struct), INTENT (InOut) :: run_start_date
    TYPE(PRISM_Time_Struct), INTENT (InOut) :: run_end_date

    INTEGER, INTENT (Out) :: error

    INTEGER :: sasa_c_get_element_3rd_level_i, sasa_c_get_element_3rd_level_d 

!!$    experiment_start_date%second = 0
!!$    experiment_end_date%second = 0
!!$    run_start_date%second = 0
!!$    run_end_date%second = 0

! experiment_start_date collection
    error = &
       sasa_c_get_element_3rd_level_d (ig_SCC_handle, &
       'experiment', 0, 'start_date', 0, 'date', 0,   &
       'second', 0, experiment_start_date%second)
    error = &
       sasa_c_get_element_3rd_level_i (ig_SCC_handle, &
       'experiment', 0, 'start_date', 0, 'date', 0,   &
       'minute', 0, experiment_start_date%minute)
    error = &
       sasa_c_get_element_3rd_level_i (ig_SCC_handle, &
       'experiment', 0, 'start_date', 0, 'date', 0,   &
       'hour', 0, experiment_start_date%hour)
    error = &
       sasa_c_get_element_3rd_level_i (ig_SCC_handle, &
       'experiment', 0, 'start_date', 0, 'date', 0,   &
       'day', 0, experiment_start_date%day)
    error = &
       sasa_c_get_element_3rd_level_i (ig_SCC_handle, &
       'experiment', 0, 'start_date', 0, 'date', 0,   &
       'month', 0, experiment_start_date%month)
    error = &
       sasa_c_get_element_3rd_level_i (ig_SCC_handle, &
       'experiment', 0, 'start_date', 0, 'date', 0,   &
       'year', 0, experiment_start_date%year)

! experiment_end_date collection
    error = &
       sasa_c_get_element_3rd_level_d (ig_SCC_handle, &
       'experiment', 0, 'end_date', 0, 'date', 0,   &
       'second', 0, experiment_end_date%second)
    error = &
       sasa_c_get_element_3rd_level_i (ig_SCC_handle, &
       'experiment', 0, 'end_date', 0, 'date', 0,     &
       'minute', 0, experiment_end_date%minute)
    error = &
       sasa_c_get_element_3rd_level_i (ig_SCC_handle, &
       'experiment', 0, 'end_date', 0, 'date', 0,     &
       'hour', 0, experiment_end_date%hour)
    error = &
       sasa_c_get_element_3rd_level_i (ig_SCC_handle, &
       'experiment', 0, 'end_date', 0, 'date', 0,     &
       'day', 0, experiment_end_date%day)
    error = &
       sasa_c_get_element_3rd_level_i (ig_SCC_handle, &
       'experiment', 0, 'end_date', 0, 'date', 0,     &
       'month', 0, experiment_end_date%month)
    error = &
       sasa_c_get_element_3rd_level_i (ig_SCC_handle, &
       'experiment', 0, 'end_date', 0, 'date', 0,     &
       'year', 0, experiment_end_date%year)

! run_start_date collection
    error = &
       sasa_c_get_element_3rd_level_d (ig_SCC_handle, &
       'run', 0, 'start_date', 0, 'date', 0,          &
       'second', 0,  run_start_date%second)
    error = &
       sasa_c_get_element_3rd_level_i (ig_SCC_handle, &
       'run', 0, 'start_date', 0, 'date', 0,          &
       'minute', 0,  run_start_date%minute)
    error = &
       sasa_c_get_element_3rd_level_i (ig_SCC_handle, &
       'run', 0, 'start_date', 0, 'date', 0,          &
       'hour', 0, run_start_date%hour)
    error = &
       sasa_c_get_element_3rd_level_i (ig_SCC_handle, &
       'run', 0, 'start_date', 0, 'date', 0,          &
       'day', 0, run_start_date%day)
    error = &
       sasa_c_get_element_3rd_level_i (ig_SCC_handle, &
       'run', 0, 'start_date', 0, 'date', 0,          &
       'month', 0, run_start_date%month)
    error = &
       sasa_c_get_element_3rd_level_i (ig_SCC_handle, &
       'run', 0, 'start_date', 0, 'date', 0,          &
       'year', 0, run_start_date%year)

! run_end_date collection
    error = &
       sasa_c_get_element_3rd_level_d (ig_SCC_handle, &
       'run', 0, 'end_date', 0, 'date', 0,          &
       'second', 0, run_end_date%second)
    error = &
       sasa_c_get_element_3rd_level_i (ig_SCC_handle, &
       'run', 0, 'end_date', 0, 'date', 0,            &
       'minute', 0, run_end_date%minute)
    error = &
       sasa_c_get_element_3rd_level_i (ig_SCC_handle, &
       'run', 0, 'end_date', 0, 'date', 0,            &
       'hour', 0, run_end_date%hour)
    error = &
       sasa_c_get_element_3rd_level_i (ig_SCC_handle, &
       'run', 0, 'end_date', 0, 'date', 0,            &
       'day', 0, run_end_date%day)
    error = &
       sasa_c_get_element_3rd_level_i (ig_SCC_handle, &
       'run', 0, 'end_date', 0, 'date', 0,            &
       'month', 0, run_end_date%month)
    error = &
       sasa_c_get_element_3rd_level_i (ig_SCC_handle, &
       'run', 0, 'end_date', 0, 'date', 0,            &
       'year', 0, run_end_date%year)

  END SUBROUTINE get_dates

!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
! Get the number of applications
!

  SUBROUTINE get_appli_number (appli_number, error)

    INTEGER, INTENT (Out) :: appli_number ! nb of applications
    INTEGER, INTENT (Out) :: error

    INTEGER :: sasa_c_get_number_1st_level

    error = sasa_c_get_number_1st_level (ig_SCC_handle, &
            'application', appli_number)

    IF (error .eq. 2) error = 0

  END SUBROUTINE get_appli_number

!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
! Get the names, exe_names, nb of hosts and nb of comps for all the appli
!

  SUBROUTINE get_appli_details ( appli_number,         &
     appli_names, appli_exe_names, appli_nb_hosts,     &
     appli_redirect, appli_nb_comps, appli_nb_args,    &
     error)

    INTEGER, INTENT (In) :: appli_number

    CHARACTER(LEN=max_name),DIMENSION(0:appli_number),INTENT (Out) :: 
       appli_names ! names of the different applications

    CHARACTER(LEN=max_name),DIMENSION(0:appli_number),INTENT (Out) :: 
       appli_exe_names ! names of the different application executables

    INTEGER, DIMENSION(0:appli_number), INTENT (Out) :: 
       appli_redirect ! stdout redirected or not for all applications

    INTEGER, DIMENSION(0:appli_number), INTENT (Out) :: 
       appli_nb_hosts ! number of hosts for each application

    INTEGER, DIMENSION(0:appli_number), INTENT (Out) :: 
       appli_nb_comps ! number of components for each application

    INTEGER, DIMENSION(0:appli_number), INTENT (Out) :: 
       appli_nb_args ! number of arguments for each application

    INTEGER, INTENT (Out) :: error

    CHARACTER(LEN=max_name) :: cla_char
    CHARACTER(LEN=max_name) :: cla_appli_redirect

    INTEGER :: sasa_c_get_number_2nd_level, sasa_c_get_attri_1st_level
    INTEGER :: sasa_c_convert_char2int

    INTEGER :: i, il_length  

    appli_names     = " "
    appli_exe_names     = " "
    cla_appli_redirect = " "

   if (appli_names(0) .NE. 'Stand alone') then
      appli_names(0)     = "oasis4"
      appli_exe_names(0) = "../../../bin/prismdrv_main"
      appli_nb_hosts(0) = 1
      appli_nb_args(0) = 0
      appli_nb_comps(0) = 1
    endif

    DO i = 1, appli_number

      error = &
         sasa_c_get_number_2nd_level(      &
         ig_SCC_handle, 'application', i,  &
         'host', appli_nb_hosts(i))

      error = &
         sasa_c_get_number_2nd_level(      &
         ig_SCC_handle, 'application', i,  &
         'argument', appli_nb_args(i))

      error = &
         sasa_c_get_number_2nd_level(      &
         ig_SCC_handle, 'application', i,  &
         'component', appli_nb_comps(i))

      error = &
         sasa_c_get_attri_1st_level(       &
         ig_SCC_handle, 'application', i,  &
         'local_name', cla_char, il_length)
      appli_names(i) = ' '
      appli_names(i) = cla_char(1:il_length)
      
      error = &
         sasa_c_get_attri_1st_level(       &
         ig_SCC_handle, 'application', i,  &
         'executable_name', cla_char, il_length)
      appli_exe_names(i) = ' '
      appli_exe_names(i) = cla_char(1:il_length)

      error = &
         sasa_c_get_attri_1st_level(       &
         ig_SCC_handle, 'application', i,  &
         'redirect', cla_char, il_length)
      cla_appli_redirect = ' '
      cla_appli_redirect = cla_char(1:il_length)

      appli_redirect(i) = sasa_c_convert_char2int(TRIM(cla_appli_redirect))    

      IF (error .eq. 2) error = 0

    END DO

  END SUBROUTINE get_appli_details
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
! Get the arguments for all one appli
! 

  SUBROUTINE get_appliarg_details ( id_appli_number,   &
     id_appli_nb_args,  &
     cda_appli_args,    &
     error )

    INTEGER, INTENT (In)  :: 
       id_appli_number ! application number

    INTEGER, INTENT (In)             :: 
       id_appli_nb_args ! nb of arguments for the appli

    CHARACTER(LEN=max_name),DIMENSION(id_appli_nb_args),INTENT(Out):: 
       cda_appli_args ! arguments for the application

    INTEGER, INTENT (Out) :: error

    INTEGER :: sasa_c_get_element_1st_level_c

    INTEGER :: ib, il_length

    cda_appli_args = " "

    IF (id_appli_nb_args .ne. 0) THEN
        DO ib = 1, id_appli_nb_args

          error = &
             sasa_c_get_element_1st_level_c (               &
             ig_SCC_handle, 'application', id_appli_number, &
             'argument', ib, cda_appli_args(ib), il_length)

        END DO
    END IF

  END SUBROUTINE get_appliarg_details

!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
! Get the names and the numbers of processes for all hosts of one appli
! 

  SUBROUTINE get_applihost_details ( id_appli_number,        &
     id_appli_nb_hosts,      &
     cda_appli_hostnames,    &
     ida_appli_hostnbprocs,  &
     error )

    INTEGER, INTENT (In)  :: 
       id_appli_number ! application number

    INTEGER, INTENT (In)             :: 
       id_appli_nb_hosts ! nb of hosts for the appli

    CHARACTER(LEN=max_name), DIMENSION(id_appli_nb_hosts), INTENT(Out) ::
       cda_appli_hostnames ! names of the hosts for the application

    INTEGER, DIMENSION(id_appli_nb_hosts), INTENT (Out) :: 
       ida_appli_hostnbprocs ! numbers of procs of the hosts for the appli

    INTEGER, INTENT (Out) :: error

    INTEGER :: sasa_c_get_attri_2nd_level, sasa_c_get_element_2nd_level_i

    INTEGER :: ib, il_length

    CHARACTER(LEN=max_name) :: cla_char

    cda_appli_hostnames = " "

    DO ib =1, id_appli_nb_hosts

      error = &
         sasa_c_get_attri_2nd_level(ig_SCC_handle,           &
         'application', id_appli_number, 'host', ib,         &
         'local_name', cla_char, il_length)
      cda_appli_hostnames(ib) = ' '
      cda_appli_hostnames(ib) = cla_char(1:il_length)

      error = &
         sasa_c_get_element_2nd_level_i(ig_SCC_handle,       &
         'application', id_appli_number, 'host', ib,         &
         'nbr_procs', 0, ida_appli_hostnbprocs(ib))

    END DO

  END SUBROUTINE get_applihost_details

!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
! Get the names and the active processes for all comps of one appli
! 

  SUBROUTINE get_applicomp_details ( id_appli_number,           &
     id_appli_nb_comps,         &
     cda_appli_compnames,       &
     ida_appli_compnbranksets,  &
     error )

    INTEGER, INTENT (In)  :: 
       id_appli_number ! application number

    INTEGER, INTENT (In)             :: 
       id_appli_nb_comps ! nb of comps for the appli

    CHARACTER(LEN=max_name), DIMENSION(id_appli_nb_comps),INTENT(Out) :: 
       cda_appli_compnames ! names of the comps for the application

    INTEGER, DIMENSION(id_appli_nb_comps), INTENT (Out) :: 
       ida_appli_compnbranksets ! numbers of rank sets 
! for all components of the application

    INTEGER, INTENT (Out) :: error

    INTEGER :: sasa_c_get_attri_2nd_level, sasa_c_get_number_3rd_level

    INTEGER :: ib, il_length

    CHARACTER(LEN=max_name) :: cla_char

    cda_appli_compnames = " "

    DO ib = 1, id_appli_nb_comps

      error = &
         sasa_c_get_attri_2nd_level(ig_SCC_handle,           &
         'application', id_appli_number, 'component', ib,    &
         'local_name', cla_char, il_length)
      cda_appli_compnames(ib) = ' '
      cda_appli_compnames(ib) = cla_char(1:il_length)

      error = &
         sasa_c_get_number_3rd_level(ig_SCC_handle,          &
         'application', id_appli_number, 'component', ib,    &
         'rank', ida_appli_compnbranksets(ib))

    END DO

    IF (error .eq. 2) error = 0

  END SUBROUTINE get_applicomp_details

!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
! Get the rank sets (min-max-inc) for all components of one applications
! 

  SUBROUTINE get_applicomprk_detls (id_appli_number,         &
     id_appli_nbtot_rankset,  &
     ida_appli_compranks,     &
     error )

    INTEGER, INTENT (In)  :: 
       id_appli_number ! application number

    INTEGER, INTENT (In)             :: 
       id_appli_nbtot_rankset ! total nb of rank sets for the application

    INTEGER, DIMENSION(id_appli_nbtot_rankset,3), INTENT (Out) :: 
       ida_appli_compranks ! array of active ranks 
! for all components for the application (min, max, inc)

    INTEGER, INTENT (Out) :: error

    INTEGER :: sasa_c_get_number_2nd_level, sasa_c_get_number_3rd_level
    INTEGER :: sasa_c_get_element_3rd_level_i

    INTEGER :: il_nb_comp, il_nb_comprksets
    INTEGER :: ib, ib_bis, ib_ter

    IF (id_appli_nbtot_rankset .ne. 0) THEN

        error = &
           sasa_c_get_number_2nd_level (ig_SCC_handle,  &
           'application', id_appli_number,              &
           'component', il_nb_comp)

        ib_ter = 0

        DO ib =1, il_nb_comp

          error = &
             sasa_c_get_number_3rd_level (ig_SCC_handle,       &
             'application', id_appli_number, 'component', ib,  &
             'rank', il_nb_comprksets)

          DO ib_bis = 1, il_nb_comprksets

            ib_ter = ib_ter + 1
            error = &
               sasa_c_get_element_3rd_level_i (ig_SCC_handle,       &
               'application', id_appli_number, 'component', ib,     &
               'rank', ib_bis, 'min_value', 0,                      &
               ida_appli_compranks(ib_ter,1))
            error = &
               sasa_c_get_element_3rd_level_i (ig_SCC_handle,       &
               'application', id_appli_number, 'component', ib,     &
               'rank', ib_bis, 'max_value', 0,                      &
               ida_appli_compranks(ib_ter,2))
            error = &
               sasa_c_get_element_3rd_level_i (ig_SCC_handle,       &
               'application', id_appli_number, 'component', ib,     &
               'rank', ib_bis, 'increment', 0,                      &
               ida_appli_compranks(ib_ter,3))

          END DO

        END DO

    END IF

    IF (error .eq. 2) error = 0

  END SUBROUTINE get_applicomprk_detls


END MODULE PSMILe_scc