prismdrv_get_udef_transients.F90

Go to the documentation of this file.
00001 !------------------------------------------------------------------------
00002 ! Copyright 2009, CERFACS, Toulouse, France.
00003 !-----------------------------------------------------------------------
00004 !BOP
00005 !
00006 ! !ROUTINE: PRISMDrv_get_udef_transients
00007 !
00008 
00009    Subroutine PRISMDrv_get_udef_transients ( id_err )
00010 
00011 !
00012 ! !USES:
00013 !
00014   USE PSMILE_smioc
00015   USE PSMILE_smioc_interface
00016   USE PRISMDrv, dummy_interface => PRISMDrv_get_udef_transients
00017 !
00018   IMPLICIT NONE
00019 
00020 !
00021 ! !PARAMETERS:
00022 !
00023 !
00024 ! ! RETURN VALUE
00025 !
00026   INTEGER, INTENT (Out)               :: id_err   ! error value
00027 
00028 !
00029 !----------------------------------------------------------------------
00030 !
00031 ! 0. Local declarations
00032 !
00033 ! Number of input and output transients and standard names per transients
00034 ! the ila arrays are local arrays used to fill up the global iga arrays
00035   INTEGER, DIMENSION(:), ALLOCATABLE   :: ila_comp_nb_stand_name
00036   INTEGER, DIMENSION(:), ALLOCATABLE   :: ila_comp_nb_transi_in
00037   INTEGER, DIMENSION(:), ALLOCATABLE   :: ila_comp_nb_transi_out
00038 !
00039 ! Definition of the different arrays used in the driver to store the
00040 ! SMIOC Informations.
00041 ! The sla/ila structures are component structures used to fill up the global
00042 ! sga/iga structures
00043 
00044 ! Informations about the transients
00045   TYPE(transient), DIMENSION(:), ALLOCATABLE :: sla_driver_transi
00046 
00047 ! Loop indices
00048   INTEGER :: ib_c, ib_nt, ib_a, ib_g, ib_ntt, ib_ntt2, ib_nin, ib, ib_nout
00049   INTEGER :: ib_co, ib_o, ib_i, ibxml
00050 
00051 ! Count integers
00052   INTEGER :: il_nu, il_ng, il_ntr, il_npe, ib_p, il_combi, il_source
00053   INTEGER :: il_npartinid, il_npartoutid, il_index1, il_index2
00054 
00055 ! Logical
00056   LOGICAL :: ll_combi, ll_source
00057 
00058 
00059   INTEGER :: il_index, ib_bis, ib_ter, il_nb_comp_pes
00060 ! Search of user-defined interpolations
00061   LOGICAL :: ll_userdef_details
00062 
00063 !     ... for error handling
00064   INTEGER, PARAMETER  :: nerrp = 2
00065   INTEGER             :: ierrp (nerrp)
00066 !
00067 ! arrays used to transfer the infos about the post id and info attributions
00068 !
00069   INTEGER, DIMENSION(7) :: ila_dim_size
00070   INTEGER               :: il_orig_index, il_dest_index, il_loc_index
00071   INTEGER               :: il_trans_orig_index, il_trans_dest_index
00072   INTEGER               :: il_cpl_rst_file_index, il_trans_interp_index
00073 
00074   INTEGER, DIMENSION(:,:), ALLOCATABLE :: ila_orig_comp_id
00075   INTEGER, DIMENSION(:,:), ALLOCATABLE :: ila_dest_comp_id
00076   INTEGER, DIMENSION(:,:), ALLOCATABLE :: ila_combi_loc
00077   INTEGER, DIMENSION(:,:), ALLOCATABLE :: ila_trans_orig_id
00078   INTEGER, DIMENSION(:,:), ALLOCATABLE :: ila_trans_dest_id
00079 !
00080 !----------------------------------------------------------------------
00081 !----------------------------------------------------------------------
00082 !
00083 !
00084 #ifdef VERBOSE
00085   PRINT *, '| | Enter PRISMDrv_get_udef_transients'
00086   CALL PSMILe_Flushstd
00087 #endif
00088 !
00089 !-----------------------------------------------------------------------
00090 !
00091 !  Get total number of transients described in SMIOC XML files
00092 !
00093      DO ib_c = 1, ig_nb_tot_comps
00094 !    explore each component SMIOC
00095 
00096 !   gather info on XML grids and transients only
00097     CALL get_smioc_grids_transi_nb ( iga_comp_id_doc_XML(ib_c),     &
00098                                      iga_xml_comp_nb_grids(ib_c),   &
00099                                      iga_comp_nb_transi(ib_c),      &
00100                                      id_err )
00101     PRINT *,'| | |Nb of grids      in component: ',ib_c, iga_xml_comp_nb_grids(ib_c)
00102     PRINT *,'| | |Nb of transients in component: ',ib_c, iga_comp_nb_transi(ib_c)
00103 
00104     IF (id_err .ne. 0) THEN
00105        PRINT *, '| | |WARNING: Pb in get_smioc_grids_transi_nb   id_err = ',id_err
00106        PRINT *, '| | |  Nb of transients ',      iga_comp_nb_transi(ib_c)
00107        PRINT *, '| | |  Nb of grids ',           iga_xml_comp_nb_grids(ib_c)
00108        PRINT *, '| | |   '
00109     ENDIF
00110     ig_nb_tot_transi = ig_nb_tot_transi + iga_comp_nb_transi(ib_c)
00111     ig_nb_tot_xml_grids = ig_nb_tot_xml_grids + iga_xml_comp_nb_grids(ib_c)
00112     PRINT *, '| | |Nb of XML transients total', ig_nb_tot_transi
00113     PRINT *, '| | |Nb of XML grids      total', ig_nb_tot_xml_grids
00114 
00115 !   Allocate structure for user_defined Interp for each transient in component
00116     ALLOCATE ( sga_comp_udef_idx(ib_c)%sla_driver_udef(iga_comp_nb_transi(ib_c)),            stat=id_err )
00117     IF (id_err > 0) THEN
00118       ierrp (1) = id_err
00119       ierrp (2) = iga_comp_nb_transi(ib_c)
00120       id_err = 13
00121 
00122       CALL Psmile_Error_Common ( id_err, 'sla_driver_udef', &
00123          ierrp, 2, __FILE__, __LINE__ )
00124       RETURN
00125     ENDIF
00126 
00127 
00128     ENDDO              ! loop ib_c on components
00129 !
00130 !  Allocate global structures
00131 !
00132     ALLOCATE ( sga_xml_smioc_transi (ig_nb_tot_transi), stat=id_err )
00133     IF (id_err > 0) THEN
00134       ierrp (1) = id_err
00135       ierrp (2) = ig_nb_tot_transi
00136       id_err = 13
00137 
00138       CALL Psmile_Error_Common ( id_err, 'sga_xml_smioc_transi', &
00139          ierrp, 2, __FILE__, __LINE__ )
00140       RETURN
00141     ENDIF
00142 
00143 #ifdef VERBOSE
00144   PRINT *, '| | |  '
00145   PRINT *, '| | | Global structure allocated (for transients only)'
00146   CALL PSMILe_Flushstd
00147 #endif
00148 !
00149 !-----------------------------------------------------------------------
00150 !
00151 ! 4. Get the number of times the transient variables are sent and
00152 !    the number of time they are received to allocate the global structure
00153 !
00154 #ifdef VERBOSE
00155   PRINT *, '| | |  '
00156   PRINT *, '| | | Get the transient numbers '
00157   CALL PSMILe_Flushstd
00158 #endif
00159 ! 4.1. Allocate the total count arrays
00160 !      for numbers of standard names, inputs and outputs
00161   ALLOCATE (iga_comp_nb_stand_name(ig_nb_tot_transi), stat=id_err)
00162   IF (id_err > 0) THEN
00163       ierrp (1) = id_err
00164       ierrp (2) = ig_nb_tot_transi
00165       id_err = 13
00166 
00167       CALL Psmile_Error_Common ( id_err, 'iga_comp_nb_stand_name', &
00168          ierrp, 2, __FILE__, __LINE__ )
00169       RETURN
00170   ENDIF
00171   ALLOCATE (iga_comp_nb_transi_in(ig_nb_tot_transi), stat=id_err)
00172   IF (id_err > 0) THEN
00173       ierrp (1) = id_err
00174       ierrp (2) = ig_nb_tot_transi
00175       id_err = 13
00176 
00177       CALL Psmile_Error_Common ( id_err, 'iga_comp_nb_transi_in', &
00178          ierrp, 2, __FILE__, __LINE__ )
00179       RETURN
00180   ENDIF
00181   ALLOCATE (iga_comp_nb_transi_out(ig_nb_tot_transi), stat=id_err)
00182   IF (id_err > 0) THEN
00183       ierrp (1) = id_err
00184       ierrp (2) = ig_nb_tot_transi
00185       id_err = 13
00186 
00187       CALL Psmile_Error_Common ( id_err, 'Nb tot transi', &
00188          ierrp, 2, __FILE__, __LINE__ )
00189       RETURN
00190   ENDIF
00191 
00192   il_ntr = 0
00193 
00194   ! 4.3. For each comp
00195   DO ib_c = 1, ig_nb_tot_comps
00196 
00197     IF (iga_comp_nb_transi(ib_c) .gt. 0) THEN
00198 
00199 ! 4.3.1. Allocate the local count arrays
00200     ALLOCATE (ila_comp_nb_stand_name(iga_comp_nb_transi(ib_c)), stat=id_err)
00201     IF (id_err > 0) THEN
00202         ierrp (1) = id_err
00203         ierrp (2) = iga_comp_nb_transi(ib_c)
00204         id_err = 13
00205 
00206         CALL Psmile_Error_Common ( id_err, 'ila_comp_nb_stand_name', &
00207            ierrp, 2, __FILE__, __LINE__ )
00208         RETURN
00209     ENDIF
00210     ALLOCATE (ila_comp_nb_transi_in(iga_comp_nb_transi(ib_c)), stat=id_err)
00211     IF (id_err > 0) THEN
00212         ierrp (1) = id_err
00213         ierrp (2) = iga_comp_nb_transi(ib_c)
00214         id_err = 13
00215 
00216         CALL Psmile_Error_Common ( id_err, 'ila_comp_nb_transi_in', &
00217            ierrp, 2, __FILE__, __LINE__ )
00218         RETURN
00219     ENDIF
00220     ALLOCATE (ila_comp_nb_transi_out(iga_comp_nb_transi(ib_c)), stat=id_err)
00221     IF (id_err > 0) THEN
00222         ierrp (1) = id_err
00223         ierrp (2) = iga_comp_nb_transi(ib_c)
00224         id_err = 13
00225 
00226         CALL Psmile_Error_Common ( id_err, 'ila_comp_nb_transi_out', &
00227            ierrp, 2, __FILE__, __LINE__ )
00228         RETURN
00229     ENDIF
00230 
00231 ! 4.3.2. For all transients of the component, get the number of times they
00232 !        are sent and the number of time they are received
00233 !
00234 !   First pass : gather info in XML files only
00235     ll_userdef_details = .true.
00236     CALL get_transi_io_numbers ( iga_comp_id_doc_XML(ib_c),  &
00237                                  iga_comp_nb_transi(ib_c),   &
00238                                  ila_comp_nb_stand_name(:),  &
00239                                  ila_comp_nb_transi_in(:),   &
00240                                  ila_comp_nb_transi_out(:),  &
00241                                  ib_c,                       &
00242                                  ll_userdef_details,         &
00243                                  id_err )
00244  IF (id_err .ne. 0) PRINT *, '| | |WARNING: Pb in get_transi_io_numbers    id_err = ',id_err  
00245 
00246 ! 4.3.3. set the global count array for transient in and out
00247     iga_comp_nb_stand_name  &
00248        (il_ntr+1:il_ntr+iga_comp_nb_transi(ib_c)) &
00249        = ila_comp_nb_stand_name(:)
00250     iga_comp_nb_transi_in  &
00251        (il_ntr+1:il_ntr+iga_comp_nb_transi(ib_c)) &
00252        = ila_comp_nb_transi_in(:)
00253     iga_comp_nb_transi_out  &
00254        (il_ntr+1:il_ntr+iga_comp_nb_transi(ib_c)) &
00255        = ila_comp_nb_transi_out(:)
00256 
00257     il_ntr = il_ntr + iga_comp_nb_transi(ib_c)
00258 
00259 ! 4.3.5. Deallocate component local counters
00260     DEALLOCATE (ila_comp_nb_stand_name, stat=id_err)
00261     IF (id_err > 0) THEN
00262         ierrp (1) = id_err
00263         id_err = 14
00264 
00265         CALL Psmile_Error_Common ( id_err, 'ila_comp_nb_stand_name', &
00266            ierrp, 1, __FILE__, __LINE__ )
00267         RETURN
00268     ENDIF
00269     DEALLOCATE (ila_comp_nb_transi_in, stat=id_err)
00270     IF (id_err > 0) THEN
00271         ierrp (1) = id_err
00272         id_err = 14
00273 
00274         CALL Psmile_Error_Common ( id_err, 'ila_comp_nb_transi_in', &
00275            ierrp, 1, __FILE__, __LINE__ )
00276         RETURN
00277     ENDIF
00278     DEALLOCATE (ila_comp_nb_transi_out, stat=id_err)
00279     IF (id_err > 0) THEN
00280         ierrp (1) = id_err
00281         id_err = 14
00282 
00283         CALL Psmile_Error_Common ( id_err, 'ila_comp_nb_transi_out', &
00284            ierrp, 1, __FILE__, __LINE__ )
00285         RETURN
00286     ENDIF
00287 
00288   END IF
00289 
00290   ENDDO   ! Loop on components : ib_c = 1, ig_nb_tot_comps
00291 
00292 
00293 ! 4.4. Allocate standard name, transient_out, and transient_in
00294 !      in global transient structure
00295   DO ib_ntt = 1, ig_nb_tot_transi
00296     ALLOCATE (sga_xml_smioc_transi(ib_ntt)%sg_transi_in%sga_in_orig &
00297        (iga_comp_nb_transi_in(ib_ntt)), stat=id_err)
00298     IF (id_err > 0) THEN
00299         ierrp (1) = id_err
00300         ierrp (2) = iga_comp_nb_transi_in(ib_ntt)
00301         id_err = 13
00302 
00303         CALL Psmile_Error_Common ( id_err, 'sga_in_orig', &
00304            ierrp, 2, __FILE__, __LINE__ )
00305         RETURN
00306     ENDIF
00307     ALLOCATE (sga_xml_smioc_transi(ib_ntt)%sga_transi_out &
00308        (iga_comp_nb_transi_out(ib_ntt)), stat=id_err)
00309     IF (id_err > 0) THEN
00310         ierrp (1) = id_err
00311         ierrp (2) = iga_comp_nb_transi_out(ib_ntt)
00312         id_err = 13
00313 
00314         CALL Psmile_Error_Common ( id_err, 'sga_transi_out', &
00315            ierrp, 2, __FILE__, __LINE__ )
00316         RETURN
00317     ENDIF
00318     ALLOCATE (sga_xml_smioc_transi(ib_ntt)%cga_stand_name &
00319        (iga_comp_nb_stand_name(ib_ntt)), stat=id_err)
00320     IF (id_err > 0) THEN
00321         ierrp (1) = id_err
00322         ierrp (2) = iga_comp_nb_stand_name(ib_ntt)
00323         id_err = 13
00324 
00325         CALL Psmile_Error_Common ( id_err, 'cga_stand_name', &
00326            ierrp, 2, __FILE__, __LINE__ )
00327         RETURN
00328     ENDIF
00329   ENDDO
00330 
00331 
00332 ! 4.5. Initialize the global transient structure
00333 #ifdef VERBOSE
00334   PRINT *, '| | |  Before init_transi'
00335   CALL PSMILe_Flushstd
00336 #endif
00337   CALL init_transi (ig_nb_tot_transi,        &
00338                     iga_comp_nb_stand_name,  &
00339                     iga_comp_nb_transi_in,   &
00340                     iga_comp_nb_transi_out,  &
00341                     sga_xml_smioc_transi,        &
00342                     id_err )
00343 #ifdef VERBOSE
00344   PRINT *, '| | |  After init_transi   id_err = ',id_err
00345   CALL PSMILe_Flushstd
00346 #endif
00347   IF (id_err .ne. 0) PRINT *, '| | |WARNING: Pb in init_transi'
00348 
00349 ! 5. Get the transient details
00350   il_ntr = 0
00351   il_npartinid = 0
00352   il_npartoutid = 0
00353 
00354   DO ib_c = 1, ig_nb_tot_comps
00355 
00356 ! 5.1. Allocate and fill component transient structure
00357     ALLOCATE (ila_comp_nb_stand_name(iga_comp_nb_transi(ib_c)), stat=id_err)
00358     IF (id_err > 0) THEN
00359         ierrp (1) = id_err
00360         ierrp (2) = iga_comp_nb_transi(ib_c)
00361         id_err = 13
00362 
00363         CALL Psmile_Error_Common ( id_err, 'ila_comp_nb_stand_name', &
00364            ierrp, 2, __FILE__, __LINE__ )
00365         RETURN
00366     ENDIF
00367     ALLOCATE (ila_comp_nb_transi_in(iga_comp_nb_transi(ib_c)), stat=id_err)
00368     IF (id_err > 0) THEN
00369         ierrp (1) = id_err
00370         ierrp (2) = iga_comp_nb_transi(ib_c)
00371         id_err = 13
00372 
00373         CALL Psmile_Error_Common ( id_err, 'ila_comp_nb_transi_in', &
00374            ierrp, 2, __FILE__, __LINE__ )
00375         RETURN
00376     ENDIF
00377     ALLOCATE (ila_comp_nb_transi_out(iga_comp_nb_transi(ib_c)), stat=id_err)
00378     IF (id_err > 0) THEN
00379         ierrp (1) = id_err
00380         ierrp (2) = iga_comp_nb_transi(ib_c)
00381         id_err = 13
00382 
00383         CALL Psmile_Error_Common ( id_err, 'ila_comp_nb_transi_out', &
00384            ierrp, 2, __FILE__, __LINE__ )
00385         RETURN
00386     ENDIF
00387     ALLOCATE (sla_driver_transi (iga_comp_nb_transi(ib_c)), stat=id_err)
00388     IF (id_err > 0) THEN
00389         ierrp (1) = id_err
00390         ierrp (2) = iga_comp_nb_transi(ib_c)
00391         id_err = 13
00392 
00393         CALL Psmile_Error_Common ( id_err, 'sla_driver_transi', &
00394            ierrp, 2, __FILE__, __LINE__ )
00395         RETURN
00396     ENDIF
00397 
00398     ila_comp_nb_stand_name(:) = iga_comp_nb_stand_name  &
00399        (il_ntr+1:il_ntr+iga_comp_nb_transi(ib_c))
00400     ila_comp_nb_transi_in(:) = iga_comp_nb_transi_in  &
00401        (il_ntr+1:il_ntr+iga_comp_nb_transi(ib_c))
00402     ila_comp_nb_transi_out(:) = iga_comp_nb_transi_out  &
00403        (il_ntr+1:il_ntr+iga_comp_nb_transi(ib_c))
00404 
00405 
00406 ! 5.3. Allocate standard name and transient_out and transient_in
00407 !      in component transient structure
00408     DO ib_nt = 1, iga_comp_nb_transi(ib_c)
00409       ALLOCATE (sla_driver_transi(ib_nt)%sg_transi_in%sga_in_orig(ila_comp_nb_transi_in(ib_nt)), stat=id_err)
00410       IF (id_err > 0) THEN
00411           ierrp (1) = id_err
00412           ierrp (2) = ila_comp_nb_transi_in(ib_nt)
00413           id_err = 13
00414 
00415           CALL Psmile_Error_Common ( id_err, 'sga_in_orig', &
00416              ierrp, 2, __FILE__, __LINE__ )
00417           RETURN
00418       ENDIF
00419       ALLOCATE (sla_driver_transi(ib_nt)%sga_transi_out(ila_comp_nb_transi_out(ib_nt)), stat=id_err)
00420       IF (id_err > 0) THEN
00421           ierrp (1) = id_err
00422           ierrp (2) = ila_comp_nb_transi_out(ib_nt)
00423           id_err = 13
00424 
00425           CALL Psmile_Error_Common ( id_err, 'sga_transi_out', &
00426              ierrp, 2, __FILE__, __LINE__ )
00427           RETURN
00428       ENDIF
00429       ALLOCATE (sla_driver_transi(ib_nt)%cga_stand_name(ila_comp_nb_stand_name(ib_nt)), stat=id_err)
00430       IF (id_err > 0) THEN
00431           ierrp (1) = id_err
00432           ierrp (2) = ila_comp_nb_stand_name(ib_nt)
00433           id_err = 13
00434 
00435           CALL Psmile_Error_Common ( id_err, 'cga_stand_name', &
00436              ierrp, 2, __FILE__, __LINE__ )
00437           RETURN
00438       ENDIF
00439     ENDDO
00440 
00441 !      Allocate transient in and out structures for user-defined interpolations
00442     DO ib_nt = 1, iga_comp_nb_transi(ib_c)
00443       ALLOCATE (sga_comp_udef_idx(ib_c)%sla_driver_udef(ib_nt)%lga_trin_orig(ila_comp_nb_transi_in(ib_nt)), stat=id_err)
00444       IF (id_err > 0) THEN
00445           ierrp (1) = id_err
00446           ierrp (2) = ila_comp_nb_transi_in(ib_nt)
00447           id_err = 13
00448 
00449           CALL Psmile_Error_Common ( id_err, 'lga_trin_orig', &
00450              ierrp, 2, __FILE__, __LINE__ )
00451           RETURN
00452       ENDIF
00453       ALLOCATE (sga_comp_udef_idx(ib_c)%sla_driver_udef(ib_nt)%lga_trout(ila_comp_nb_transi_out(ib_nt)), stat=id_err)
00454       IF (id_err > 0) THEN
00455           ierrp (1) = id_err
00456           ierrp (2) = ila_comp_nb_transi_out(ib_nt)
00457           id_err = 13
00458 
00459           CALL Psmile_Error_Common ( id_err, 'lga_trout', &
00460              ierrp, 2, __FILE__, __LINE__ )
00461           RETURN
00462       ENDIF
00463     ENDDO
00464 
00465 ! 5.4. Initialize the component transient structure
00466 #ifdef VERBOSE
00467   PRINT *, '| | |  Before init_transi bis'
00468   CALL PSMILe_Flushstd
00469 #endif
00470     CALL init_transi (iga_comp_nb_transi(ib_c),  &
00471                       ila_comp_nb_stand_name,    &
00472                       ila_comp_nb_transi_in,     &
00473                       ila_comp_nb_transi_out,    &
00474                       sla_driver_transi,         &
00475                       id_err )
00476     CALL init_comp_udef ( iga_comp_nb_transi(ib_c),  &
00477                           ila_comp_nb_transi_in,     &
00478                           ila_comp_nb_transi_out,    &
00479                           ib_c,                      &
00480                           id_err )
00481 #ifdef VERBOSE
00482   PRINT *, '| | |  After init_transi bis   id_err = ', id_err
00483   CALL PSMILe_Flushstd
00484 #endif
00485     IF (id_err .ne. 0) PRINT *, '| | |WARNING: Pb in init_transi bis'
00486 
00487 ! 5.5. Get transient details for all transients of the component
00488 !
00489 ! 5.5.1 Get details for all transients with SASA
00490 #ifdef VERBOSE
00491   PRINT *, '| | |  Before get_transi'
00492   CALL PSMILe_Flushstd
00493 #endif
00494 !   Set flag for first call to transi_details
00495     ll_userdef_details = .true.
00496 !   extract informations
00497     CALL get_transi_details (iga_comp_id_doc_XML(ib_c),  &
00498                              iga_comp_nb_transi(ib_c),   &
00499                              sla_driver_transi(:),       &
00500                              ib_c,                       &
00501                              ll_userdef_details,           &
00502                              id_err )
00503 #ifdef VERBOSE
00504   PRINT *, '| | |  After get_transi_details   first pass  id_err = ',id_err
00505   CALL PSMILe_Flushstd
00506 #endif
00507     IF (id_err .ne. 0) PRINT *, '| | |WARNING: Pb in get_transi_details'
00508 
00509 
00510 
00511 ! 5.5.2 Set the component, transient, grid, transient in and transient out ids
00512 !       Component id
00513     sla_driver_transi(:)%ig_comp_id = ib_c
00514     DO ib_nt = 1, iga_comp_nb_transi(ib_c)
00515       ib_a = il_ntr+ib_nt
00516       ! Global transient id
00517       sla_driver_transi(ib_nt)%ig_transi_id = ib_a
00518       ! Global Transient in id
00519       DO ib_nin= 1, sla_driver_transi(ib_nt)%sg_transi_in%ig_nb_in_orig
00520         sla_driver_transi(ib_nt)%sg_transi_in%sga_in_orig(ib_nin)%ig_transi_in_id &
00521            = il_npartinid + ib_nin
00522       ENDDO
00523       il_npartinid = il_npartinid + sla_driver_transi(ib_nt)%sg_transi_in%ig_nb_in_orig
00524       ! GLobal Transient out id
00525       DO ib_nout= 1, sla_driver_transi(ib_nt)%ig_nb_transi_out
00526         sla_driver_transi(ib_nt)%sga_transi_out(ib_nout)%ig_transi_out_id &
00527            = il_npartoutid + ib_nout
00528       ENDDO
00529       il_npartoutid = il_npartoutid + sla_driver_transi(ib_nt)%ig_nb_transi_out
00530     ENDDO
00531 
00532     ! 5.6. Put local transient details in global structure
00533     sga_xml_smioc_transi (il_ntr+1:il_ntr+iga_comp_nb_transi(ib_c)) = &
00534        sla_driver_transi(:)
00535 
00536     ! 5.7. Keep first pass values of transient numbers in iga_xml_comp_nb_transi(ib_c)
00537     iga_xml_comp_nb_transi(ib_c) = iga_comp_nb_transi(ib_c)
00538 
00539     ! 5.8. Deallocate the local arrays
00540     DEALLOCATE (ila_comp_nb_stand_name, stat=id_err)
00541     IF (id_err > 0) THEN
00542         ierrp (1) = id_err
00543         id_err = 14
00544 
00545         CALL Psmile_Error_Common ( id_err, 'ila_comp_nb_stand_name', &
00546            ierrp, 1, __FILE__, __LINE__ )
00547         RETURN
00548     ENDIF
00549     DEALLOCATE (ila_comp_nb_transi_in, stat=id_err)
00550     IF (id_err > 0) THEN
00551         ierrp (1) = id_err
00552         id_err = 14
00553 
00554         CALL Psmile_Error_Common ( id_err, 'ila_comp_nb_transi_in', &
00555            ierrp, 1, __FILE__, __LINE__ )
00556         RETURN
00557     ENDIF
00558     DEALLOCATE (ila_comp_nb_transi_out, stat=id_err)
00559     IF (id_err > 0) THEN
00560         ierrp (1) = id_err
00561         id_err = 14
00562 
00563         CALL Psmile_Error_Common ( id_err, 'ila_comp_nb_transi_out', &
00564            ierrp, 1, __FILE__, __LINE__ )
00565         RETURN
00566     ENDIF
00567     DEALLOCATE (sla_driver_transi, stat=id_err)
00568     IF (id_err > 0) THEN
00569         ierrp (1) = id_err
00570         id_err = 14
00571 
00572         CALL Psmile_Error_Common ( id_err, 'sla_driver_transi', &
00573            ierrp, 1, __FILE__, __LINE__ )
00574         RETURN
00575     ENDIF
00576 
00577     il_ntr = il_ntr + iga_comp_nb_transi(ib_c)
00578 
00579   END DO     ! end loop on components (ib_c)
00580 
00581 ! Check coherency between transi_in and transi_out information
00582 ! and detect the transients "out" associated with Userd_defined Interpolation
00583 !
00584   DO ib_ntt = 1, ig_nb_tot_transi
00585     DO ib_nout = 1, sga_xml_smioc_transi(ib_ntt)%ig_nb_transi_out
00586 
00587       DO ib_ntt2 = 1, ig_nb_tot_transi
00588         DO ib_nin = 1, sga_xml_smioc_transi(ib_ntt2)%sg_transi_in%ig_nb_in_orig
00589 
00590 #ifdef DEBUG
00591 ! Check coherency between transi_in and transi_out information
00592           IF (TRIM(sga_xml_smioc_transi(ib_ntt)%sga_transi_out(ib_nout)%          &
00593              cg_transi_out_name) .EQ. trim(sga_xml_smioc_transi(ib_ntt2)%         &
00594              sg_transi_in%sga_in_orig(ib_nin)%cg_orig_transi) .AND.           &
00595              trim(sga_xml_smioc_transi(ib_ntt2)%sg_transi_in%sga_in_orig(ib_nin)% &
00596              cg_transi_in_name) .NE. trim(sga_xml_smioc_transi(ib_ntt)%           &
00597              sga_transi_out(ib_nout)%cg_dest_transi)) THEN
00598               PRINT *, '| | |  Incoherency in corresponding source and target XML info'
00599               PRINT *, '| | |  for transient ', sga_xml_smioc_transi(ib_ntt)%     &
00600                  sga_transi_out(ib_nout)%cg_dest_transi
00601               CALL PSMILe_abort
00602           ENDIF
00603           IF (TRIM(sga_xml_smioc_transi(ib_ntt)%sga_transi_out(ib_nout)%          &
00604              cg_transi_out_name) .NE. trim(sga_xml_smioc_transi(ib_ntt2)%         &
00605              sg_transi_in%sga_in_orig(ib_nin)%cg_orig_transi) .AND.           &
00606              trim(sga_xml_smioc_transi(ib_ntt2)%sg_transi_in%sga_in_orig(ib_nin)% &
00607              cg_transi_in_name) .EQ. trim(sga_xml_smioc_transi(ib_ntt)%           &
00608              sga_transi_out(ib_nout)%cg_dest_transi)) THEN
00609               PRINT *, '| | |  Incoherency in corresponding source and target XML info'
00610               PRINT *, '| | |  for transient ', sga_xml_smioc_transi(ib_ntt2)%    &
00611                  sg_transi_in%sga_in_orig(ib_nin)%cg_orig_transi
00612               CALL PSMILe_abort
00613           ENDIF
00614 #endif
00615           IF (trim(sga_xml_smioc_transi(ib_ntt)%sga_transi_out(ib_nout)%          &
00616              cg_transi_out_name) .EQ. trim(sga_xml_smioc_transi(ib_ntt2)%         &
00617              sg_transi_in%sga_in_orig(ib_nin)%cg_orig_transi) .AND.           &
00618              trim(sga_xml_smioc_transi(ib_ntt2)%sg_transi_in%sga_in_orig(ib_nin)% &
00619              cg_transi_in_name) .EQ. trim(sga_xml_smioc_transi(ib_ntt)%           &
00620              sga_transi_out(ib_nout)%cg_dest_transi)) THEN
00621 
00622 !   Get component id "ib_c" and transient_in number "ib" from "ib_ntt2"
00623              call trans_index( ig_nb_tot_comps, ib_ntt2, ib_c, ib)
00624 !   Check if transient_in "ib" and origin "ib_nin" needs a User_defined interpolation
00625              IF ( sga_comp_udef_idx(ib_c)%sla_driver_udef(ib)%  &
00626                                         lga_trin_orig(ib_nin) ) THEN
00627 !   Get component id "ib_co" and transient_in number "ib_o" from "ib_ntt"
00628                 call trans_index( ig_nb_tot_comps, ib_ntt, ib_co, ib_o)
00629 !   Flag the corresponding transient_out ib_o in component ib_co for origin ib_nout
00630                 sga_comp_udef_idx(ib_co)%sla_driver_udef(ib_o)%  &
00631                                         lga_trout(ib_nout) = .true.
00632                 sga_comp_udef_idx(ib_co)%sla_driver_udef(ib_o)%lg_trans_ud = .true.
00633 !   copy the transient (ib_ntt) name into sla_driver_udef(ib_o) cg_local_name
00634                 sga_comp_udef_idx(ib_co)%sla_driver_udef(ib_o)%cg_local_name = &
00635                                   sga_xml_smioc_transi(ib_ntt)%cg_local_name               
00636             ENDIF    ! transients in and out needs User_defined Interpolation
00637           ENDIF    ! found association of one origin and one output for any transient
00638 
00639         ENDDO
00640       ENDDO
00641 
00642     ENDDO
00643   ENDDO
00644 !
00645 !  Get dimensionning numbers for "udef" transients
00646 !
00647 !  Number of udef transients per component : iga_comp_nb_udef(:)
00648 !  Number of "gridless" transients per components : ig_tot_comp_ugl
00649 !  Since each udef transient has a specific grid and a specific gridfunction
00650 !  every transi_in%origin and every transi_out%output must be associated to 
00651 !  new "User-defined GridLess" (ugl) transient
00652    DO ib_c = 1, ig_nb_tot_comps
00653       iga_comp_nb_udef(ib_c) = 0
00654       sga_comp_udef_idx(ib_c)%ig_xml_udef = 0
00655       sga_comp_udef_idx(ib_c)%ig_tot_comp_ugl = 0
00656 !  Loop on all SMIOC transients in component
00657       DO ib = 1, iga_comp_nb_transi(ib_c)
00658         IF ( sga_comp_udef_idx(ib_c)%sla_driver_udef(ib)%lg_trans_ud ) THEN
00659 !     Count "xml smioc" transients with user3D interpolation     
00660           sga_comp_udef_idx(ib_c)%ig_xml_udef = sga_comp_udef_idx(ib_c)%ig_xml_udef + 1
00661 !     Count all "user3D" interpolations for all origins and all outputs
00662            DO ib_i = 1, sga_comp_udef_idx(ib_c)%sla_driver_udef(ib)%ig_dim_orig
00663               IF ( sga_comp_udef_idx(ib_c)%sla_driver_udef(ib)%lga_trin_orig(ib_i) ) THEN
00664                  iga_comp_nb_udef(ib_c) = iga_comp_nb_udef(ib_c) + 1
00665               ENDIF
00666            ENDDO
00667            DO ib_o = 1, sga_comp_udef_idx(ib_c)%sla_driver_udef(ib)%ig_dim_out
00668               IF ( sga_comp_udef_idx(ib_c)%sla_driver_udef(ib)%lga_trout(ib_o) ) THEN
00669                  iga_comp_nb_udef(ib_c) = iga_comp_nb_udef(ib_c) + 1
00670               ENDIF
00671            ENDDO
00672          ENDIF
00673       ENDDO
00674       sga_comp_udef_idx(ib_c)%ig_tot_comp_ugl = iga_comp_nb_udef(ib_c)
00675 #ifdef DEBUG
00676       print *,' component ', ib_c,' ig_xml_udef = ',sga_comp_udef_idx(ib_c)%ig_xml_udef
00677 #endif
00678    ENDDO
00679 #ifdef DEBUG
00680    print *,' iga_comp_nb_udef(:) = ',iga_comp_nb_udef(:) 
00681 #endif
00682 !
00683 !  From now on : we know  :
00684 !  the number of "gridless" transients to be created per comp. = iga_comp_nb_udef(:)
00685 !
00686 !  Allocate + fill iga_trans_udef(:) for each component:
00687 !  Keep indexes of "udef" transients in the XML SMIOC file, for each component
00688 
00689 !  Additional internal check : (Not mandatory)
00690 !  Allocate + fill iga_xml_trindex(:) 
00691 !  keep index of xml"udef" transient for each "gridless" transient
00692 !
00693    DO ib_c = 1, ig_nb_tot_comps
00694 
00695       ibxml = sga_comp_udef_idx(ib_c)%ig_xml_udef
00696       ALLOCATE (sga_comp_udef_idx(ib_c)%iga_trans_udef(ibxml), stat=id_err)
00697       IF (id_err > 0) THEN
00698           ierrp (1) = id_err
00699           ierrp (2) = iga_comp_nb_udef(ib_c)
00700           id_err = 13
00701           CALL Psmile_Error_Common ( id_err, 'iga_trans_udef', &
00702              ierrp, 2, __FILE__, __LINE__ )
00703           RETURN
00704       ENDIF
00705 !
00706       ALLOCATE (sga_comp_udef_idx(ib_c)%iga_xml_trindex(iga_comp_nb_udef(ib_c)), stat=id_err)
00707       IF (id_err > 0) THEN
00708           ierrp (1) = id_err
00709           ierrp (2) = iga_comp_nb_udef(ib_c)
00710           id_err = 13
00711           CALL Psmile_Error_Common ( id_err, 'iga_xml_trindex', &
00712              ierrp, 2, __FILE__, __LINE__ )
00713           RETURN
00714       ENDIF
00715 !
00716       ib_nt = 0
00717       DO ib = 1, iga_comp_nb_transi(ib_c)
00718          IF ( sga_comp_udef_idx(ib_c)%sla_driver_udef(ib)%lg_trans_ud ) THEN
00719               ib_nt = ib_nt + 1
00720               sga_comp_udef_idx(ib_c)%iga_trans_udef(ib_nt) = ib
00721          ENDIF
00722       ENDDO
00723 
00724 ! Fill array : iga_xml_trindex
00725       ib_nt = 0
00726       DO ib = 1, iga_comp_nb_transi(ib_c)
00727         IF ( sga_comp_udef_idx(ib_c)%sla_driver_udef(ib)%lg_trans_ud ) THEN
00728 !     Count all "user3D" interpolations for all origins and all outputs
00729 !     An associated "gridless" transient is created for each input and output channel
00730 !     only if the flag "userdef" is .true.
00731           DO ib_i = 1, sga_comp_udef_idx(ib_c)%sla_driver_udef(ib)%ig_dim_orig
00732             IF ( sga_comp_udef_idx(ib_c)%sla_driver_udef(ib)%lga_trin_orig(ib_i) ) THEN
00733                  ib_nt = ib_nt + 1
00734                  sga_comp_udef_idx(ib_c)%iga_xml_trindex(ib_nt) = ib
00735             ENDIF
00736           ENDDO
00737           DO ib_o = 1, sga_comp_udef_idx(ib_c)%sla_driver_udef(ib)%ig_dim_out
00738              IF ( sga_comp_udef_idx(ib_c)%sla_driver_udef(ib)%lga_trout(ib_o) ) THEN
00739                 ib_nt = ib_nt + 1
00740                 sga_comp_udef_idx(ib_c)%iga_xml_trindex(ib_nt) = ib
00741              ENDIF
00742           ENDDO
00743         ENDIF
00744       ENDDO
00745 
00746    ENDDO    !  DO ib_c = 1, ig_nb_tot_comps
00747 
00748   DEALLOCATE ( iga_comp_nb_stand_name, stat=id_err)
00749         IF (id_err > 0) THEN
00750             ierrp (1) = id_err
00751             id_err = 14
00752             CALL Psmile_Error_Common ( id_err, 'iga_comp_nb_stand_name', &
00753                ierrp, 1, __FILE__, __LINE__ )
00754             RETURN
00755         ENDIF
00756   DEALLOCATE (iga_comp_nb_transi_in, stat=id_err)
00757   IF (id_err > 0) THEN
00758       ierrp (1) = id_err
00759       id_err = 14
00760       CALL Psmile_Error_Common ( id_err, 'iga_comp_nb_transi_in', &
00761          ierrp, 2, __FILE__, __LINE__ )
00762       RETURN
00763   ENDIF
00764   DEALLOCATE (iga_comp_nb_transi_out, stat=id_err)
00765   IF (id_err > 0) THEN
00766       ierrp (1) = id_err
00767       id_err = 14
00768       CALL Psmile_Error_Common ( id_err, 'iga_comp_nb_transi_out', &
00769          ierrp, 2, __FILE__, __LINE__ )
00770       RETURN
00771   ENDIF
00772 !
00773 !  Reset global counters to 0 and keep present value in ig_nb_tot_xml_transi
00774   ig_nb_tot_xml_transi = ig_nb_tot_transi
00775   PRINT *, '| | |  Total Nb of XML transients ', ig_nb_tot_xml_transi
00776   PRINT *, '| | |  * * *  End of First Pass  * * * '
00777 !
00778   ig_nb_tot_transi = 0
00779   iga_comp_nb_transi(:) = 0
00780 !
00781   ig_nb_tot_grids = 0
00782   iga_comp_nb_grids(:) = 0
00783 
00784   RETURN
00785   END Subroutine PRISMDrv_get_udef_transients 
00786 
00787 !==============================================================================
00788 
00789   Subroutine trans_index ( il_comp, il_g, ib_c, ib)
00790 
00791   USE PSMILE_smioc, ONLY : iga_comp_nb_transi
00792 !
00793   IMPLICIT NONE
00794 
00795 !! INPUT parameters
00796 
00797 !  il_comp : total number of components : ig_nb_tot_comps
00798 
00799 !  Global number of transients per component : iga_comp_nb_transi(:)
00800 
00801 !  il_g  : global index for transient
00802 
00803 !! OUTPUT parameters
00804 
00805 !  ib_c : global index of component
00806 
00807 !  ib : index of transient in component
00808 
00809    INTEGER,               INTENT(IN) :: il_comp
00810    INTEGER,               INTENT(IN) :: il_g
00811 
00812    INTEGER,               INTENT(OUT) :: ib_c
00813    INTEGER,               INTENT(OUT) :: ib
00814 !
00815 !  LOCAL VARIABLES
00816 !
00817    INTEGER   :: ncount,  ncountprev
00818    INTEGER   :: ic
00819 !--------------------------------------------------------------------------
00820 !
00821    ncount     = 0
00822    ncountprev = 0
00823 
00824    ib_c = 0
00825    ib   = 0
00826 
00827    DO ic = 1, il_comp
00828       ncount = ncount + iga_comp_nb_transi(ic)
00829       ib_c = ib_c + 1
00830       IF ( il_g .LE. ncount   .AND.   il_g .GT. ncountprev ) exit
00831       ncountprev = ncount
00832    ENDDO
00833   
00834    ib = il_g - ncountprev
00835 
00836 #ifdef DEBUG
00837    print *," size of iga_comp_nb_transi = ", SIZE(iga_comp_nb_transi)
00838    print *, "trans_index :  il_g  ib_c  ib = ", il_g, ib_c, ib
00839 #endif
00840 
00841    RETURN
00842 
00843    END Subroutine trans_index
00844 
00845 !============================================================================