get_cnct_target_details.F90

Go to the documentation of this file.

!------------------------------------------------------------------------
! Copyright 2006-2010, CERFACS, Toulouse, France.
! All rights reserved. Use is subject to license terms.
!------------------------------------------------------------------------
!BOP
!
!======================================================================
!
  SUBROUTINE get_cnct_target_details ( id_XML_doc,  &
     cda_xpath,         &
     ld_coupling,       &
     ld_source_is_file, &
     sd_target,         &
     id_error )
! !DESCRIPTION
! This routine extracts, from a CIM XML file, the informations about a connection or a coupling
! at the target endpoint
!
!----------------------------------------------------------------------
!
    USE PSMILe_smioc
    IMPLICIT NONE
!
!EOP
!----------------------------------------------------------------------
!
! 0. Declaration
!
! handle of XML content of the CIM file
    INTEGER, INTENT(In) :: id_XML_doc

! XPath character string
    CHARACTER(len=*), INTENT(In)  :: cda_xpath

! Flag for coupling (true) or connection (false)
    LOGICAL, INTENT(In) :: ld_coupling

! Flag for when the source of coupling is a file
    LOGICAL, INTENT(In) :: ld_source_is_file
! Data structure to fill in
    TYPE(transient_in), INTENT(InOut) :: sd_target

! returned error code
    INTEGER, INTENT(Out):: id_error

! Target as character string = "couplingTarget" or "connectionTarget"
    CHARACTER(len=16) cla_target

! Property as character string = "couplingProperty" or "connectionProperty"
    CHARACTER(len=18) cla_property

! temporary character string
    CHARACTER(LEN=max_name) :: cla_char
    INTEGER :: il_test, il_length
    INTEGER :: il_exchange_rate
    DOUBLE PRECISION  :: dl_test
    
    INTEGER :: sasa_c_get_element_2nd_level_i
    INTEGER :: sasa_c_get_element_3rd_level_c
    INTEGER :: sasa_c_get_element_2nd_level_d 
    INTEGER :: sasa_c_get_attri_2nd_level, sasa_c_get_attri_3rd_level
    INTEGER :: sasa_c_convert_char2int

! Character string = "Coupling" or "connection"
    IF (ld_coupling) THEN
        cla_target   = "couplingTarget"
        cla_property = "couplingProperty"
    ELSE
        cla_target   = "connectionTarget"
        cla_property = "connectionProperty"
    ENDIF

    ! Get the exchange period
    il_exchange_rate = -1
    id_error = &
        sasa_c_get_element_2nd_level_i (id_XML_doc, cda_xpath, 0,   &
        "timeProfile", 0, "rate", 0, il_exchange_rate)

print *, "il_exchange_rate", il_exchange_rate
    ! If there is an exchange period specified
    if (il_exchange_rate .ne. -1 .and. il_exchange_rate .ne. PSMILe_undef) then
    
        ! When a connection connects two component fields (or transients),
        ! the exchange period is analysed twice : for the source and the target
        ! This is too bad.
        ! Because the CIM file is analysed several times : once for each component
        
        sd_target%ig_exch_date_type = PSMILe_period

        ! Get the exchange period units
        cla_char = ' '
        id_error = &
            sasa_c_get_attri_2nd_level (id_XML_doc, cda_xpath, 0,   &
            "timeProfile", 0, "units", cla_char, il_length)
        if (il_length .ne. 0) then
          if (cla_char .eq."seconds") then
              sd_target%sg_exch_date%sg_period%second = il_exchange_rate
          else if (cla_char .eq."minutes") then
              sd_target%sg_exch_date%sg_period%minute = il_exchange_rate
          else if (cla_char .eq."hours") then
              sd_target%sg_exch_date%sg_period%hour = il_exchange_rate
          else if (cla_char .eq."days") then
              sd_target%sg_exch_date%sg_period%day = il_exchange_rate
          else if (cla_char .eq."months") then
              sd_target%sg_exch_date%sg_period%month = il_exchange_rate
          else if (cla_char .eq."years") then
              sd_target%sg_exch_date%sg_period%year = il_exchange_rate
          else 
              PRINT *, '***************************************************'
              PRINT *, 'Unsupported timeProfile units in XML data:', cla_char
              PRINT *, '***************************************************'
              CALL PSMILe_Flushstd

              CALL MPI_Abort(MPI_COMM_WORLD, 1, id_error)
          endif
        else
            PRINT *, '*****************************************'
            PRINT *, 'Unspecified timeProfile units in XML data'
            PRINT *, '*****************************************'
            CALL PSMILe_Flushstd

            CALL MPI_Abort(MPI_COMM_WORLD, 1, id_error)
        endif
    endif

    IF (ld_source_is_file) THEN
        ! *** Get the target local transformation for add scalar
        id_error = &
            sasa_c_get_element_2nd_level_d (id_XML_doc, cda_xpath, 0,   &
            TRIM(cla_property)//'[name="add_scalar"]', 0,               &
            "value", 0, dl_test)
        IF ( dl_test /= PSMILe_dundef ) THEN
            sd_target%sg_tgt_local_trans%dg_add_scalar = dl_test
        ENDIF

        ! *** Get the target local transformation for mult scalar
        id_error = &
            sasa_c_get_element_2nd_level_d (id_XML_doc, cda_xpath, 0,    &
            TRIM(cla_property)//'[name="mult_scalar"]', 0,               &
            "value", 0, dl_test)
        IF ( dl_test /= PSMILe_dundef ) THEN
            sd_target%sg_tgt_local_trans%dg_mult_scalar = dl_test
        ENDIF
    ENDIF

    ! *** Get the target time operation
    id_error = &
        sasa_c_get_attri_3rd_level (id_XML_doc, cda_xpath, 0,                     &
        "timeTransformation", 0, "mappingType", 0, "value", cla_char, il_length)
    if (il_length > 0) then
      if (cla_char .eq. "TimeInterpolation") then
        sd_target%ig_tgt_timeop = PSMILe_time_linear
      else
        sd_target%ig_tgt_timeop = PSMILe_time_nnghbr
      endif
    endif

    ! *** Get the target "non-masked point gathering" operation
    id_error = &
        sasa_c_get_element_3rd_level_c (id_XML_doc, cda_xpath, 0,            &
        TRIM(cla_target), 0, TRIM(cla_property)//'[name="gathering"]', 0,    &
        "value", 0, cla_char, il_length)
    if (il_length > 0) then
        ! cla_char is "true" or "false"
        sd_target%sg_tgt_local_trans%ig_gather = sasa_c_convert_char2int(cla_char(1:il_length))
    endif

    ! *** Get the target statistics options
    id_error = &
        sasa_c_get_element_3rd_level_c (id_XML_doc, cda_xpath, 0,                           &
        TRIM(cla_target), 0, TRIM(cla_property)//'[name="statistics_masked_points"]', 0,    &
        "value", 0, cla_char, il_length)
    if (il_length > 0) then
        ! cla_char is "true" or "false"
        sd_target%iga_stats(1) = sasa_c_convert_char2int(cla_char(1:il_length))
    endif
    
    id_error = &
        sasa_c_get_element_3rd_level_c (id_XML_doc, cda_xpath, 0,                              &
        TRIM(cla_target), 0, TRIM(cla_property)//'[name="statistics_notmasked_points"]', 0,    &
        "value", 0, cla_char, il_length)
    if (il_length > 0) then
        ! cla_char is "true" or "false"
        sd_target%iga_stats(2) = sasa_c_convert_char2int(cla_char(1:il_length))
    endif
    
    id_error = &
        sasa_c_get_element_3rd_level_c (id_XML_doc, cda_xpath, 0,                        &
        TRIM(cla_target), 0, TRIM(cla_property)//'[name="statistics_all_points"]', 0,    &
        "value", 0, cla_char, il_length)
    if (il_length > 0) then
        ! cla_char is "true" or "false"
        sd_target%iga_stats(3) = sasa_c_convert_char2int(cla_char(1:il_length))
    endif

    ! *** Get the target debug mode
    id_error = &
        sasa_c_get_element_3rd_level_c (id_XML_doc, cda_xpath, 0,             &
        TRIM(cla_target), 0, TRIM(cla_property)//'[name="debug_mode"]', 0,    &
        "value", 0, cla_char, il_length)
    if (il_length > 0) then
        ! cla_char is "true" or "false"
        sd_target%ig_debugmode = sasa_c_convert_char2int(cla_char(1:il_length))
    endif


  END SUBROUTINE get_cnct_target_details

!
!======================================================================