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