get_cnct_source_details.F90

Go to the documentation of this file.
00001 !------------------------------------------------------------------------
00002 ! Copyright 2006-2010, CERFACS, Toulouse, France.
00003 ! All rights reserved. Use is subject to license terms.
00004 !------------------------------------------------------------------------
00005 !BOP
00006 !
00007 !======================================================================
00008 !
00009   SUBROUTINE get_cnct_source_details ( id_XML_doc,  &
00010      cda_xpath,         &
00011      ld_coupling,       &
00012      sd_source,         &
00013      id_error )
00014 ! !DESCRIPTION
00015 ! This routine extracts, from a CIM XML file, the informations about a connection or a coupling
00016 ! at the source endpoint
00017 !
00018 !----------------------------------------------------------------------
00019 !
00020     USE PSMILe_smioc
00021     IMPLICIT NONE
00022 !
00023 !EOP
00024 !----------------------------------------------------------------------
00025 !
00026 ! 0. Declaration
00027 !
00028 ! handle of XML content of the CIM file
00029     INTEGER, INTENT(In) :: id_XML_doc
00030 
00031 ! XPath character string
00032     CHARACTER(len=*), INTENT(In)  :: cda_xpath
00033 
00034 ! Flag for coupling (true) or connection (false)
00035     LOGICAL, INTENT(In) :: ld_coupling
00036 
00037 ! Data structure to fill in
00038     TYPE(transient_out), INTENT(InOut) :: sd_source
00039 
00040 ! returned error code
00041     INTEGER, INTENT(Out):: id_error
00042 
00043 ! Source as character string = "couplingSource" or "connectionSource"
00044     CHARACTER(len=16) cla_source
00045 
00046 ! Property as character string = "couplingProperty" or "connectionProperty"
00047     CHARACTER(len=18) cla_property
00048 
00049 ! temporary character string
00050     CHARACTER(LEN=max_name) :: cla_char
00051     INTEGER :: il_test, il_length
00052     INTEGER :: il_exchange_rate
00053     DOUBLE PRECISION  :: dl_test
00054     
00055     INTEGER :: sasa_c_get_element_2nd_level_i
00056     INTEGER :: sasa_c_get_element_3rd_level_c
00057     INTEGER :: sasa_c_get_element_2nd_level_d 
00058     INTEGER :: sasa_c_get_attri_2nd_level, sasa_c_get_attri_3rd_level
00059     INTEGER :: sasa_c_convert_char2int
00060 
00061 ! Character string = "Coupling" or "connection"
00062     IF (ld_coupling) THEN
00063         cla_source   = "couplingSource"
00064         cla_property = "couplingProperty"
00065     ELSE
00066         cla_source   = "connectionSource"
00067         cla_property = "connectionProperty"
00068     ENDIF
00069 
00070     ! Get the exchange period
00071     il_exchange_rate = -1
00072     id_error = &
00073         sasa_c_get_element_2nd_level_i (id_XML_doc, cda_xpath, 0,   &
00074         "timeProfile", 0, "rate", 0, il_exchange_rate)
00075     
00076     ! If there is an exchange period specified
00077     if (il_exchange_rate .ne. -1 .and. il_exchange_rate .ne. PSMILe_undef) then
00078     
00079         ! When a connection connects two component fields (or transients),
00080         ! the exchange period is analysed twice : for the source and the target
00081         ! This is too bad.
00082         ! Because the CIM file is analysed several times : once for each component
00083         
00084         sd_source%ig_exch_date_type = PSMILe_period
00085 
00086         ! Get the exchange period units
00087         cla_char = ' '
00088         id_error = &
00089             sasa_c_get_attri_2nd_level (id_XML_doc, cda_xpath, 0,   &
00090             "timeProfile", 0, "units", cla_char, il_length)
00091         if (il_length .ne. 0) then
00092           if (cla_char .eq."seconds") then
00093               sd_source%sg_exch_date%sg_period%second = il_exchange_rate
00094           else if (cla_char .eq."minutes") then
00095               sd_source%sg_exch_date%sg_period%minute = il_exchange_rate
00096           else if (cla_char .eq."hours") then
00097               sd_source%sg_exch_date%sg_period%hour = il_exchange_rate
00098           else if (cla_char .eq."days") then
00099               sd_source%sg_exch_date%sg_period%day = il_exchange_rate
00100           else if (cla_char .eq."months") then
00101               sd_source%sg_exch_date%sg_period%month = il_exchange_rate
00102           else if (cla_char .eq."years") then
00103               sd_source%sg_exch_date%sg_period%year = il_exchange_rate
00104           else 
00105               PRINT *, '***************************************************'
00106               PRINT *, 'Unsupported timeProfile units in XML data:', cla_char
00107               PRINT *, '***************************************************'
00108               CALL PSMILe_Flushstd
00109 
00110               CALL MPI_Abort(MPI_COMM_WORLD, 1, id_error)
00111           endif
00112         else
00113             PRINT *, '*****************************************'
00114             PRINT *, 'Unspecified timeProfile units in XML data'
00115             PRINT *, '*****************************************'
00116             CALL PSMILe_Flushstd
00117 
00118             CALL MPI_Abort(MPI_COMM_WORLD, 1, id_error)
00119         endif
00120     endif
00121 
00122     ! *** Get the source local transformation for add scalar
00123     id_error = &
00124         sasa_c_get_element_2nd_level_d (id_XML_doc, cda_xpath, 0,   &
00125         TRIM(cla_property)//'[name="add_scalar"]', 0,               &
00126         "value", 0, dl_test)
00127     IF ( dl_test /= PSMILe_dundef ) THEN
00128         sd_source%sg_src_local_trans%dg_add_scalar = dl_test
00129     ENDIF
00130 
00131     ! *** Get the source local transformation for mult scalar
00132     id_error = &
00133         sasa_c_get_element_2nd_level_d (id_XML_doc, cda_xpath, 0,    &
00134         TRIM(cla_property)//'[name="mult_scalar"]', 0,               &
00135         "value", 0, dl_test)
00136     IF ( dl_test /= PSMILe_dundef ) THEN
00137         sd_source%sg_src_local_trans%dg_mult_scalar = dl_test
00138     ENDIF
00139 
00140 
00141     ! *** Get the source time operation
00142     id_error = &
00143         sasa_c_get_attri_3rd_level (id_XML_doc, cda_xpath, 0,                     &
00144         "timeTransformation", 0, "mappingType", 0, "value", cla_char, il_length)
00145     if (il_length > 0) then
00146       if (cla_char .eq. "TimeAverage") then
00147         sd_source%ig_src_timeop = PSMIle_tave
00148       else if (cla_char .eq. "TimeAccumulation") then
00149         sd_source%ig_src_timeop = PSMILe_tacc
00150       endif
00151     endif
00152 
00153     ! *** Get the lag
00154     id_error = &
00155         sasa_c_get_element_2nd_level_i (id_XML_doc, cda_xpath, 0,   &
00156         "timeLag", 0, "value", 0, il_test)
00157     if ( il_test /= PSMILe_undef .and. il_test /= 0) &
00158         sd_source%ig_lag = il_test
00159 
00160     ! *** Get the source "non-masked point scattering" operation
00161     id_error = &
00162         sasa_c_get_element_3rd_level_c (id_XML_doc, cda_xpath, 0,            &
00163         TRIM(cla_source), 0, TRIM(cla_property)//'[name="scattering"]', 0,    &
00164         "value", 0, cla_char, il_length)
00165     if (il_length > 0) then
00166         ! cla_char is "true" or "false"
00167         sd_source%sg_src_local_trans%ig_scatter  = sasa_c_convert_char2int(cla_char(1:il_length))
00168     endif
00169 
00170     ! *** Get the source statistics options
00171     id_error = &
00172         sasa_c_get_element_3rd_level_c (id_XML_doc, cda_xpath, 0,                           &
00173         TRIM(cla_source), 0, TRIM(cla_property)//'[name="statistics_masked_points"]', 0,    &
00174         "value", 0, cla_char, il_length)
00175     if (il_length > 0) then
00176         ! cla_char is "true" or "false"
00177         sd_source%iga_stats(1) = sasa_c_convert_char2int(cla_char(1:il_length))
00178     endif
00179     
00180     id_error = &
00181         sasa_c_get_element_3rd_level_c (id_XML_doc, cda_xpath, 0,                              &
00182         TRIM(cla_source), 0, TRIM(cla_property)//'[name="statistics_notmasked_points"]', 0,    &
00183         "value", 0, cla_char, il_length)
00184     if (il_length > 0) then
00185         ! cla_char is "true" or "false"
00186         sd_source%iga_stats(2) = sasa_c_convert_char2int(cla_char(1:il_length))
00187     endif
00188     
00189     id_error = &
00190         sasa_c_get_element_3rd_level_c (id_XML_doc, cda_xpath, 0,                        &
00191         TRIM(cla_source), 0, TRIM(cla_property)//'[name="statistics_all_points"]', 0,    &
00192         "value", 0, cla_char, il_length)
00193     if (il_length > 0) then
00194         ! cla_char is "true" or "false"
00195         sd_source%iga_stats(3) = sasa_c_convert_char2int(cla_char(1:il_length))
00196     endif
00197 
00198     ! *** Get the source debug mode
00199     id_error = &
00200         sasa_c_get_element_3rd_level_c (id_XML_doc, cda_xpath, 0,             &
00201         TRIM(cla_source), 0, TRIM(cla_property)//'[name="debug_mode"]', 0,    &
00202         "value", 0, cla_char, il_length)
00203     if (il_length > 0) then
00204         ! cla_char is "true" or "false"
00205         sd_source%ig_debugmode = sasa_c_convert_char2int(cla_char(1:il_length))
00206     endif
00207 
00208 
00209   END SUBROUTINE get_cnct_source_details
00210 
00211 !
00212 !======================================================================