get_transi_io_numbers.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_transi_io_numbers ( id_XML_doc,  &
                                     id_nb_transi,       &
                                     ida_nb_stand_name,  &
                                     ida_nb_transi_in,   &
                                     ida_nb_transi_out,  &
                                     id_comp,            &
                                     cda_app_name,       &
                                     cda_comp_name,      &
                                     ld_first_details,   &
                                     id_error  )

! !DESCRIPTION
! This routine gives the number of input and output for each transi
! of one smioc
!
!----------------------------------------------------------------------
!
    USE PSMILe_smioc
    IMPLICIT NONE
!
!EOP
!----------------------------------------------------------------------
! $Id: psmile_smioc.F90 1793 2008-11-25 14:58:31Z valcke $
! $Author: valcke $
!----------------------------------------------------------------------
!
! 0. Declaration
!
! handle of XML content of the smioc file
    INTEGER, INTENT(In) :: id_XML_doc

! number of transi variables for the component
    INTEGER, INTENT(In) :: id_nb_transi  

! number of standard name per transi for the component
    INTEGER, DIMENSION(id_nb_transi), INTENT(Out) :: ida_nb_stand_name

! number of input transi per transi for the component
    INTEGER, DIMENSION(id_nb_transi), INTENT(Out) :: ida_nb_transi_in

! number of output transi per transi for the component
    INTEGER, DIMENSION(id_nb_transi), INTENT(Out) :: ida_nb_transi_out

! Component id
    INTEGER, INTENT(In) :: id_comp

! Names of application and component
    CHARACTER(len=*), INTENT(In)  :: cda_app_name
    CHARACTER(len=*), INTENT(In)  :: cda_comp_name

! logical flag first pass / second pass
    LOGICAL, INTENT(In)  :: ld_first_details

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

! loop index
    INTEGER   :: ib,  ib_nt, ib_xml, ib_u
    INTEGER   :: il_xml_transi
!
#if CIM
  ! Name of all transients of the component
    Character(len=max_name), Allocatable :: cla_transient_name(:)
    INTEGER :: il_length
    
    ! Predicates for the search in XML path
    CHARACTER(len=282) :: cla_model_appli
    CHARACTER(len=282) :: cla_model_comp
    CHARACTER(len=282) :: cla_ref_comp
    
    ! total nb of, index of couplings
    INTEGER :: il_nb_couplings, il_coupling, il_test
    ! Index of connection
    INTEGER :: il_connection
    ! Name of the transient at one end of a connection
    Character(len=max_name) :: cl_connection_end
    
    !     ... for error handling
    INTEGER, PARAMETER  :: nerrp = 2
    INTEGER             :: ierrp (nerrp)
  
    INTEGER :: sasa_c_get_number_3rd_level, sasa_c_get_number_6th_level, sasa_c_get_number_8th_level
    INTEGER :: sasa_c_get_element_7th_level_c
#else
    INTEGER :: sasa_c_get_number_3rd_level, sasa_c_get_number_4th_level
    INTEGER :: sasa_c_get_number_5th_level
#endif!
!----------------------------------------------------------------------
!
!  At first pass (called from prismdrv_get_udef_transients) :
!  id_nb_transi = il_xml_transi = number of transients in XML SMIOC file
!  At second pass (called from prismdrv_init_smioc_struct) :
!  id_nb_transi = total number of transients including "udef" transients
    IF ( ld_first_details ) THEN
       il_xml_transi = id_nb_transi
    ELSE
       il_xml_transi = id_nb_transi - iga_comp_nb_udef(id_comp)
    ENDIF

#if CIM
    ! Configuration data are in one CIM file
    ! --------------------------------------

    ! Allocate space for XML transient names
    ALLOCATE (cla_transient_name(il_xml_transi), stat=id_error )
    IF (id_error > 0) THEN
      ierrp (1) = id_error
      ierrp (2) = il_xml_transi
      id_error = 13

      CALL Psmile_Error_Common ( id_error, 'cla_transient_name', &
        ierrp, 2, __FILE__, __LINE__ )
      RETURN
    ENDIF

    ! Prepare two predicates for the search in the XML documents :
    !   based on application and model shortNames
    cla_model_appli = 'modelComponent[normalize-space(shortName)="'//TRIM(cda_app_name)//'"]'
    cla_model_comp  = 'modelComponent[normalize-space(shortName)="'//TRIM(cda_comp_name)//'"]'

    ! Get standard names for all component's transients
    
    ! For all the transients of the component
    DO ib =1, il_xml_transi
        ! Check if the transient is a bundle :
        !  if it, as a <componentProperty> element, has itself some <componentProperty> sub-elements
        id_error = &
            sasa_c_get_number_8th_level (id_XML_doc, &
            "simulationComposite/child/simulationRun/model/modelComponent", 0,            &
            "childComponent", 0, TRIM(cla_model_appli), 0, "childComponent", 0,           &
            TRIM(cla_model_comp), 0, "componentProperties", 0, "componentProperty", ib,   &
            "componentProperty", ida_nb_stand_name(ib))
            
        if (ida_nb_stand_name(ib) .eq. 0) then
            ! It should have at least one <standardName> sub-element
            id_error = &
                sasa_c_get_number_8th_level (id_XML_doc, &
                "simulationComposite/child/simulationRun/model/modelComponent", 0,            &
                "childComponent", 0, TRIM(cla_model_appli), 0, "childComponent", 0,           &
                TRIM(cla_model_comp), 0, "componentProperties", 0, "componentProperty", ib,   &
                "standardName", ida_nb_stand_name(ib))
        else
            ! Transient is a bundle
            ! Add 1 to account for the main standard name
            ida_nb_stand_name(ib) = ida_nb_stand_name(ib) + 1
        endif
    ENDDO
    
    ! List all component's transient names
    
    ! For all component's transients
    DO ib =1, il_xml_transi
      cla_transient_name(ib) = ' '
      id_error = &
          sasa_c_get_element_7th_level_c (id_XML_doc, &
          "simulationComposite/child/simulationRun/model/modelComponent", 0,  &
          "childComponent", 0, TRIM(cla_model_appli), 0, "childComponent", 0, &
          TRIM(cla_model_comp), 0, "componentProperties", 0, "componentProperty", ib, &
          "shortName", 0, cla_transient_name(ib), il_length)
    ENDDO

    ! Get the number of couplings
    id_error = &
        sasa_c_get_number_3rd_level (id_XML_doc, &
        "simulationComposite/child/simulationRun/model/modelComponent", 0,     &
        "composition", 0, "coupling", il_nb_couplings)

    ! Count the number of connections involving any transient of this component
    ! -------------------------------------------------------------------------
    
    ida_nb_transi_in(:) = 0
    ida_nb_transi_out(:) = 0
    
    ! Prepare a predicate for the search of a <reference>-<name> element equal to component name
    cla_ref_comp = 'reference[normalize-space(name)="'//TRIM(cda_comp_name)//'"]'
    
    ! For all couplings
    DO il_coupling =1, il_nb_couplings
        ! Test if this coupling involves the component as the source
        id_error = &
            sasa_c_get_number_6th_level (id_XML_doc, &
            "simulationComposite/child/simulationRun/model/modelComponent", 0,   &
            "composition", 0, "coupling", il_coupling, "couplingSource", 0,      &
            "dataSource", 0, TRIM(cla_ref_comp), il_test)
            
        ! if this coupling involves the component as the source
        ! "il_test" is 0 or 1
        if (il_test > 0) then
        
            ! For all connections of that coupling
            il_connection = 1
            DO WHILE (.true.)
              ! Get name of connection source : it is a transient name
              cl_connection_end = ' '
              id_error = &
                  sasa_c_get_element_7th_level_c (id_XML_doc, &
                  "simulationComposite/child/simulationRun/model/modelComponent", 0,       &
                  "composition", 0, "coupling", il_coupling, "connection", il_connection,  &
                  "connectionSource", 0, "dataSource", 0, "reference", 0, "name", 0,       &
                  cl_connection_end, il_length)

              IF (il_length .ne. 0) then
                ! Look for transient index based on its name
                
                ! For all component's transients
                DO ib =1, il_xml_transi
                  IF (cl_connection_end .eq. cla_transient_name(ib)) then
                    ! Increment number of connections involving this transient as a source
                    ida_nb_transi_out(ib) = ida_nb_transi_out(ib) + 1
                    exit
                  ENDIF
                ENDDO
                
                ! Go to next connection
                il_connection = il_connection + 1
              
              ELSE
                ! No more connections in this coupling
                exit
              ENDIF
            ENDDO
        endif
    
        ! Test if this coupling involves the component as the target
        id_error = &
            sasa_c_get_number_6th_level (id_XML_doc, &
            "simulationComposite/child/simulationRun/model/modelComponent", 0,   &
            "composition", 0, "coupling", il_coupling, "couplingTarget", 0,      &
            "dataSource", 0, TRIM(cla_ref_comp), il_test)
            
        ! if this coupling involves the component as the target
        ! "il_test" is 0 or 1
        if (il_test > 0) then
        
            ! For all connections of that coupling
            il_connection = 1
            DO WHILE (.true.)
              ! Get name of connection target : it is a transient name
              cl_connection_end = ' '
              id_error = &
                  sasa_c_get_element_7th_level_c (id_XML_doc, &
                  "simulationComposite/child/simulationRun/model/modelComponent", 0,       &
                  "composition", 0, "coupling", il_coupling, "connection", il_connection,  &
                  "connectionTarget", 0, "dataSource", 0, "reference", 0, "name", 0,       &
                  cl_connection_end, il_length)

              IF (il_length .ne. 0) then
                ! Look for transient index based on its name
                
                ! For all component's transients
                DO ib =1, il_xml_transi
                  IF (cl_connection_end .eq. cla_transient_name(ib)) then
                    ! Increment number of connections involving this transient as a target
                    ida_nb_transi_in(ib) = ida_nb_transi_in(ib) + 1
                    exit
                  ENDIF
                ENDDO
                
                ! Go to next connection
                il_connection = il_connection + 1
              
              ELSE
                ! No more connections in this coupling
                exit
              ENDIF
            ENDDO
        endif
    
    ENDDO
    
#ifdef DEBUG
    print *, "component name: ", cda_comp_name
    print *, "ida_nb_transi_in : ", ida_nb_transi_in(:)
    print *, "ida_nb_transi_out : ", ida_nb_transi_out(:)
#endif
    
    DEALLOCATE (cla_transient_name)
#else
    ! Configuration data are in a SMIOC file
    ! --------------------------------------

! For all the transients of the component
    DO ib =1, il_xml_transi
         id_error = &
         sasa_c_get_number_3rd_level(id_XML_doc,                             &
         'component', 0, 'transient', ib, 'transient_standard_name',    &
         ida_nb_stand_name(ib))
         print *,' get_transi_io_numbers id_error stand_name ib = ',ib, id_error

      id_error = &
         sasa_c_get_number_5th_level(id_XML_doc,              &
         'component', 0, 'transient', ib, 'intent', 0,   &
         'input', 0, 'origin', ida_nb_transi_in(ib))
         print *,' get_transi_io_numbers id_error transi_in ib = ',ib, id_error

      id_error = &
         sasa_c_get_number_4th_level(id_XML_doc,              &
         'component', 0, 'transient', ib, 'intent', 0,   &
         'output', ida_nb_transi_out(ib))
         print *,' get_transi_io_numbers id_error transi_out ib = ',ib, id_error
    END DO
#endif

!  At second pass (called from prismdrv_init_smioc_struct) :
!  we add indexes for userdef transients
!  It is supposed that the number of standard names are the same
!  in the associated "udef" transient
!  These numbers are copied from the geographical transient
!  In associated "gridless" transients, Number of origins = 1
!  and number of outputs = 1

    IF ( .NOT. ld_first_details ) THEN
!  "Udef" transients    
       ib_nt = 0
       DO ib_u = il_xml_transi + 1, id_nb_transi
          ib_nt = ib_nt + 1
!  ib_xml is the transient index in component XML SMIOC file
          ib_xml = sga_comp_udef_idx(id_comp)%iga_xml_trindex(ib_nt)
!  Number of standard names is the same in all associated "gridless" transients
          ida_nb_stand_name(ib_u) = ida_nb_stand_name(ib_xml)        
!  Number of origins is always 1 or 0 in gridless transients
          IF ( ida_nb_transi_in(ib_xml) .NE. 0 ) THEN 
             ida_nb_transi_in(ib_u) = 1
          ELSE
             ida_nb_transi_in(ib_u) = 0
          ENDIF
!  Number of outputs is always 1 or 0 in gridless transients
          IF ( ida_nb_transi_out(ib_xml) .NE. 0 ) THEN
             ida_nb_transi_out(ib_u) = 1
          ELSE
             ida_nb_transi_out(ib_u) = 0
          ENDIF 
       ENDDO

    ENDIF

  END SUBROUTINE get_transi_io_numbers

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