prismdrv_set_scc_info.F90

Go to the documentation of this file.
00001 !------------------------------------------------------------------------
00002 ! Copyright 2006-2010, CERFACS, Toulouse, France.
00003 ! All rights reserved. Use is subject to OASIS4 license terms.
00004 !-----------------------------------------------------------------------
00005 !BOP
00006 !
00007 ! !ROUTINE: PRISMDrv_Set_scc_info
00008 !
00009 ! !INTERFACE
00010 subroutine prismdrv_set_scc_info(id_err)
00011 
00012 !
00013 ! !USES:
00014 !
00015 #ifdef CIM
00016   USE PSMILe_cim
00017 #else
00018   USE PSMILe_scc
00019 #endif
00020   USE PRISMDrv, dummy_interface => PRISMDrv_Set_scc_info
00021 
00022   IMPLICIT NONE
00023 
00024 !
00025 ! !PARAMETERS:
00026 !
00027 
00028 !
00029 ! ! RETURN VALUE
00030 !
00031   INTEGER, INTENT (Out)               :: id_err   ! error value
00032 
00033 ! !DESCRIPTION
00034 ! Subroutine "PRISMDrv_set_scc_info" sets the information got through the
00035 ! extraction of information in the SCC file.
00036 ! Th master process collects the xml infos and broadcast the ones needed to 
00037 ! the other processes.
00038 !
00039 ! !REVISED HISTORY
00040 !   Date      Programmer   Description
00041 ! ----------  ----------   -----------
00042 ! 03/10/2002  D. Declat    Creation
00043 !
00044 ! EOP
00045 !----------------------------------------------------------------------
00046 ! $Id: prismdrv_set_scc_info.F90 3241 2011-06-23 09:55:11Z coquart $
00047 ! $Author: coquart $
00048 !----------------------------------------------------------------------
00049 !
00050 ! 0. Local declarations
00051 !
00052   CHARACTER(LEN=len_cvs_string), SAVE  :: mycvs = 
00053      '$Id: prismdrv_set_scc_info.F90 3241 2011-06-23 09:55:11Z coquart $'
00054 
00055 !
00056 ! Name of the different hosts for one application
00057   CHARACTER(LEN=max_name), DIMENSION(:), ALLOCATABLE :: cla_appli_hostname
00058 
00059 ! Name of the different components for one application
00060   CHARACTER(LEN=max_name), DIMENSION(:), ALLOCATABLE :: cla_appli_compname
00061 
00062 ! Arguments for one application
00063   CHARACTER(LEN=max_name), DIMENSION(:), ALLOCATABLE :: cla_appli_args
00064 
00065 ! Number of processes for each hosts of one application
00066   INTEGER, DIMENSION(:), ALLOCATABLE :: ila_appli_hostnbprocs 
00067 
00068 ! Number of rank sets (min-max-inc) for all components for one application
00069   INTEGER, DIMENSION(:), ALLOCATABLE :: ila_appli_compnbranksets
00070 !
00071 ! Array of rank sets (min-max-inc) for all components for one application
00072   INTEGER, DIMENSION(:,:), ALLOCATABLE :: ila_appli_compranks
00073 
00074 !
00075   INTEGER :: i, ii
00076   INTEGER :: il_MPI
00077   INTEGER :: n_arg, n_host, n_comp, n_ranksets
00078   INTEGER :: il_status(MPI_STATUS_SIZE)
00079   INTEGER :: ila_scc_info(5)
00080 !
00081   INTEGER, PARAMETER         :: nerrp=2
00082   INTEGER                    :: ierrp(nerrp)
00083 !
00084 !----------------------------------------------------------------------
00085 !----------------------------------------------------------------------
00086 !
00087 !
00088 #ifdef VERBOSE
00089   PRINT *, '| Enter PRISMDrv_set_scc_info'
00090   call psmile_flushstd
00091 #endif
00092 ! The reading of the scc xml info are done by the master process only
00093 !> WARNING This is a workaround. The real Appl%rank (rank within the local communicator is determined in prismdrv_init_appl),
00094 !>         which is called later. This Appl%rank is the global rank. (for MPI1)
00095   IF (Appl%rank == PRISMdrv_root) THEN
00096 !
00097 ! 1. Extract information from SCC
00098 !
00099 !===> open the XML general configuration file and load its elements into memory
00100 !
00101 #ifdef CIM
00102       call open_cim_file (id_err)
00103 #else
00104       call open_scc_file (id_err)
00105 #endif
00106       IF ( id_err > 0 ) THEN
00107           call PSMILe_Abort
00108       ENDIF
00109 !
00110 ! 1.1. get the way used to launch the coupled system (MPI1 or MPI2)
00111 !
00112       call get_execution_mode(ig_MPI, id_err)
00113 #ifdef VERBOSE
00114       PRINT *, '| | MPI version : ',ig_MPI
00115       call psmile_flushstd
00116 #endif
00117 ! 
00118 ! 1.1. get the number of pes for the driver/transformer
00119       call get_transformer_pes (ig_driver_nb_pes, id_err)
00120 #ifdef VERBOSE
00121       PRINT *, '| | Number of pes for the driver/transformer : ', &
00122      ig_driver_nb_pes
00123       call psmile_flushstd
00124 #endif
00125 !  
00126 ! 1.2. Check if the SCC information about the MPI implementation 
00127 !      corresponds to the pre-compilation option 
00128 !
00129 #ifdef PRISM_with_MPI1
00130 #ifdef VERBOSE
00131       PRINT *, '| | option MPI1 pour la pre-compil'
00132       call psmile_flushstd
00133 #endif
00134       il_MPI = DRV_MPI1
00135 #else
00136 #ifdef VERBOSE
00137       PRINT *, '| | option MPI2 pour la pre-compil'
00138       call psmile_flushstd
00139 #endif
00140       il_MPI = DRV_MPI2
00141 #endif
00142 
00143 !
00144 ! 2. Get the experiment and run dates
00145 !
00146       call get_dates ( sga_experiment_start_date, &
00147      sga_experiment_end_date,   &
00148      sga_run_start_date,        &
00149      sga_run_end_date,          &
00150      id_err)
00151 
00152 !  
00153 ! 3. Read the information about the different applications
00154 !
00155 ! 3.1. get the number of applications
00156 
00157       CALL get_appli_number (ig_nb_appl, id_err)
00158 #ifdef VERBOSE
00159       PRINT *, '| | Number of applications ',ig_nb_appl
00160       call psmile_flushstd
00161 #endif
00162 ! The reading of the scc xml info are done by the master process only
00163 !  IF (Appl%rank == PRISMdrv_root) THEN
00164 !
00165 ! 3.2. allocate space for the information arrays for the applications
00166 !
00167       ALLOCATE ( cga_appli_name(0:ig_nb_appl), STAT = id_err )
00168       IF ( id_err > 0 ) THEN
00169       ierrp (1) = id_err
00170       ierrp (2) = ig_nb_appl
00171       call psmile_error_common ( PRISM_Error_Alloc, 'cga_appli_name', &
00172          ierrp, 2, __FILE__, __LINE__ )
00173       ENDIF
00174       ALLOCATE ( cga_appli_exe_name(0:ig_nb_appl), STAT = id_err )
00175       IF ( id_err > 0 ) THEN
00176       ierrp (1) = id_err
00177       ierrp (2) = ig_nb_appl
00178       call psmile_error_common ( PRISM_Error_Alloc, 'cga_appli_exe_name', &
00179          ierrp, 2, __FILE__, __LINE__ )
00180       ENDIF
00181       ALLOCATE ( iga_appli_nb_pes(0:ig_nb_appl), STAT = id_err )
00182       IF ( id_err > 0 ) THEN
00183       ierrp (1) = id_err
00184       ierrp (2) = ig_nb_appl
00185       call psmile_error_common ( PRISM_Error_Alloc, 'iga_appli_nb_pes', &
00186          ierrp, 2, __FILE__, __LINE__ )
00187       ENDIF
00188       ALLOCATE ( iga_appli_nb_hosts(0:ig_nb_appl), STAT = id_err )
00189       IF ( id_err > 0 ) THEN
00190       ierrp (1) = id_err
00191       ierrp (2) = ig_nb_appl
00192       call psmile_error_common ( PRISM_Error_Alloc, 'iga_appli_nb_hosts', &
00193          ierrp, 2, __FILE__, __LINE__ )
00194       ENDIF
00195       ALLOCATE ( iga_appli_nb_comps(0:ig_nb_appl), STAT = id_err )
00196       IF ( id_err > 0 ) THEN
00197       ierrp (1) = id_err
00198       ierrp (2) = ig_nb_appl
00199       call psmile_error_common ( PRISM_Error_Alloc, 'iga_appli_nb_comps', &
00200          ierrp, 2, __FILE__, __LINE__ )
00201       ENDIF
00202       ALLOCATE ( iga_appli_nb_args(0:ig_nb_appl), STAT = id_err )
00203       IF ( id_err > 0 ) THEN
00204       ierrp (1) = id_err
00205       ierrp (2) = ig_nb_appl
00206       call psmile_error_common ( PRISM_Error_Alloc, 'iga_appli_nb_args', &
00207          ierrp, 2, __FILE__, __LINE__ )
00208       ENDIF
00209       ALLOCATE ( iga_appli_redirect(0:ig_nb_appl), STAT = id_err )
00210       IF ( id_err > 0 ) THEN
00211       ierrp (1) = id_err
00212       ierrp (2) = ig_nb_appl
00213       call psmile_error_common ( PRISM_Error_Alloc, 'iga_appli_redirect', &
00214          ierrp, 2, __FILE__, __LINE__ )
00215       ENDIF
00216       ALLOCATE ( iga_appli_nbtot_ranksets(1:ig_nb_appl), STAT = id_err )
00217       IF ( id_err > 0 ) THEN
00218       ierrp (1) = id_err
00219       ierrp (2) = ig_nb_appl
00220       call psmile_error_common ( PRISM_Error_Alloc, 'iga_appli_nbtot_ranksets', &
00221          ierrp, 2, __FILE__, __LINE__ )
00222       ENDIF
00223       ALLOCATE ( comm_coupling(0:ig_nb_appl), STAT = id_err )
00224       IF ( id_err > 0 ) THEN
00225       ierrp (1) = id_err
00226       ierrp (2) = ig_nb_appl
00227       call psmile_error_common ( PRISM_Error_Alloc, 'comm_coupling', &
00228          ierrp, 2, __FILE__, __LINE__ )
00229       ENDIF
00230 
00231 !
00232 ! 3.3. Get the name, exe_name, nb of hosts, nb of comps
00233 !      and nb of arguments for each appli
00234 !
00235       CALL get_appli_details ( ig_nb_appl,                &
00236      cga_appli_name,            &
00237      cga_appli_exe_name,        &
00238      iga_appli_nb_hosts,        &
00239      iga_appli_redirect,        &
00240      iga_appli_nb_comps,        &
00241      iga_appli_nb_args,         &
00242      id_err )
00243 
00244 !
00245 ! 3.4. Compute the total number of hosts and components
00246 !
00247       DO i = 1, ig_nb_appl
00248 
00249     ig_nb_tot_hosts =  ig_nb_tot_hosts + iga_appli_nb_hosts(i) 
00250     ig_nb_tot_comps =  ig_nb_tot_comps + iga_appli_nb_comps(i)
00251     ig_nb_tot_args  =  ig_nb_tot_args  + iga_appli_nb_args(i)
00252 
00253       END DO
00254 
00255 ! 3.5. Allocate and fill the global arrays
00256 !
00257 ! 3.5.1. Allocate the argument, host-names, host-number-of-procs 
00258 !        and component-number-of-rank-sets arrays
00259       IF (ig_nb_tot_args == 0 ) THEN
00260          ALLOCATE ( cga_appli_args(0:0), STAT = id_err )
00261          cga_appli_args(0:0)=""
00262       ELSE
00263          ALLOCATE ( cga_appli_args(ig_nb_tot_args), STAT = id_err )
00264       ENDIF
00265       IF ( id_err > 0 ) THEN
00266       ierrp (1) = id_err
00267       ierrp (2) = ig_nb_tot_args
00268       call psmile_error_common ( PRISM_Error_Alloc, 'Nb tot args', &
00269          ierrp, 2, __FILE__, __LINE__ )
00270       ENDIF
00271 
00272       ALLOCATE ( cga_appli_hostname(ig_nb_tot_hosts), STAT = id_err )
00273       IF ( id_err > 0 ) THEN
00274       ierrp (1) = id_err
00275       ierrp (2) = ig_nb_tot_hosts
00276       call psmile_error_common ( PRISM_Error_Alloc, 'cga_appli_hostname', &
00277          ierrp, 2, __FILE__, __LINE__ )
00278       ENDIF
00279       ALLOCATE ( iga_appli_hostnbprocs(ig_nb_tot_hosts), STAT = id_err )
00280       IF ( id_err > 0 ) THEN
00281       ierrp (1) = id_err
00282       ierrp (2) = ig_nb_tot_hosts
00283       call psmile_error_common ( PRISM_Error_Alloc, 'iga_appli_hostnbprocs', &
00284          ierrp, 2, __FILE__, __LINE__ )
00285       ENDIF
00286       ALLOCATE ( cga_appli_compname(ig_nb_tot_comps), STAT = id_err )
00287       IF ( id_err > 0 ) THEN
00288       ierrp (1) = id_err
00289       ierrp (2) = ig_nb_tot_comps
00290       call psmile_error_common ( PRISM_Error_Alloc, 'cga_appli_compname', &
00291          ierrp, 2, __FILE__, __LINE__ )
00292       ENDIF
00293       ALLOCATE ( iga_appli_compnbranksets(ig_nb_tot_comps), STAT = id_err )
00294       IF ( id_err > 0 ) THEN
00295       ierrp (1) = id_err
00296       ierrp (2) = ig_nb_tot_comps
00297       call psmile_error_common ( PRISM_Error_Alloc, 'iga_appli_compnbranksets', &
00298          ierrp, 2, __FILE__, __LINE__ )
00299       ENDIF
00300 
00301 ! 3.5.2. For all the applications
00302       n_arg = 0
00303       n_host = 0
00304       n_comp = 0
00305 
00306       ig_nb_tot_pes = 0
00307       iga_appli_nb_pes(0) = ig_driver_nb_pes ! number of pes for the driver
00308 
00309       DO i = 1, ig_nb_appl
00310 
00311 ! 3.5.2.1 Allocate and get for each application
00312 !         the arguments
00313 !         the names and number of procs for all hosts
00314 !         the number of rank sets for all components
00315 
00316     IF (iga_appli_nb_args(i) .gt. 0) THEN
00317         ALLOCATE ( cla_appli_args(iga_appli_nb_args(i)), STAT = id_err )
00318         IF ( id_err > 0 ) THEN
00319         ierrp (1) = id_err
00320         ierrp (2) = iga_appli_nb_args(i)
00321         call psmile_error_common ( PRISM_Error_Alloc,'Nb appli args',&
00322            ierrp, 2, __FILE__, __LINE__ )
00323         ENDIF
00324     END IF
00325 
00326     IF (iga_appli_nb_hosts(i) .gt. 0) THEN
00327         ALLOCATE ( cla_appli_hostname(iga_appli_nb_hosts(i)),STAT =id_err)
00328         IF ( id_err > 0 ) THEN
00329         ierrp (1) = id_err
00330         ierrp (2) = iga_appli_nb_hosts(i)
00331         call psmile_error_common ( PRISM_Error_Alloc,'cla_appli_hostname',&
00332            ierrp, 2, __FILE__, __LINE__ )
00333         ENDIF
00334         ALLOCATE (ila_appli_hostnbprocs(iga_appli_nb_hosts(i)),STAT =id_err)
00335         IF ( id_err > 0 ) THEN
00336         ierrp (1) = id_err
00337         ierrp (2) = iga_appli_nb_hosts(i)
00338         call psmile_error_common (PRISM_Error_Alloc,'ila_appli_hostnbprocs',&
00339            ierrp, 2, __FILE__, __LINE__ )
00340         ENDIF
00341     END IF
00342 
00343     IF (iga_appli_nb_comps(i) .gt. 0) THEN
00344         ALLOCATE (cla_appli_compname(iga_appli_nb_comps(i)),STAT = id_err)
00345         IF ( id_err > 0 ) THEN
00346         ierrp (1) = id_err
00347         ierrp (2) = iga_appli_nb_comps(i)
00348         call psmile_error_common (PRISM_Error_Alloc,'cla_appli_compname',&
00349            ierrp, 2, __FILE__, __LINE__ )
00350         ENDIF
00351         ALLOCATE (ila_appli_compnbranksets(iga_appli_nb_comps(i)), &
00352            STAT = id_err )
00353         IF ( id_err > 0 ) THEN
00354         ierrp (1) = id_err
00355         ierrp (2) = iga_appli_nb_comps(i)
00356         call psmile_error_common (PRISM_Error_Alloc,'ila_appli_compnbranksets',&
00357            ierrp, 2, __FILE__, __LINE__ )
00358         ENDIF
00359     END IF
00360 
00361 ! 3.5.2.2. Get the information for arguments, hosts and components
00362 
00363     IF (iga_appli_nb_args(i) .gt. 0) THEN
00364         CALL get_appliarg_details ( i,                    &
00365            iga_appli_nb_args(i), &
00366            cla_appli_args,       &
00367            id_err )
00368     END IF
00369 
00370     IF (iga_appli_nb_hosts(i) .gt. 0) THEN
00371         CALL get_applihost_details ( i,                     &
00372            iga_appli_nb_hosts(i), &
00373            cla_appli_hostname,    &
00374            ila_appli_hostnbprocs, &
00375            id_err )
00376 
00377         iga_appli_nb_pes(i) = SUM(ila_appli_hostnbprocs(:))
00378 
00379         ig_nb_tot_pes = ig_nb_tot_pes + iga_appli_nb_pes(i)
00380     END IF
00381 
00382     IF (iga_appli_nb_comps(i) .gt. 0) THEN
00383         CALL get_applicomp_details ( i,                        &
00384            iga_appli_nb_comps(i),    &
00385            cla_appli_compname,       & 
00386            ila_appli_compnbranksets, &
00387            id_err )
00388 
00389         iga_appli_nbtot_ranksets(i) = SUM(ila_appli_compnbranksets(:))
00390     END IF
00391 
00392 ! 3.5.2.3. Store it in the global arrays
00393 
00394     IF (iga_appli_nb_args(i) .gt. 0) THEN
00395         cga_appli_args(n_arg+1:n_arg+iga_appli_nb_args(i)) =     &
00396            cla_appli_args(:) 
00397     END IF
00398 
00399     IF (iga_appli_nb_hosts(i) .gt. 0) THEN
00400         iga_appli_hostnbprocs(n_host+1:n_host+iga_appli_nb_hosts(i)) =  &
00401            ila_appli_hostnbprocs(:)     
00402         cga_appli_hostname(n_host+1:n_host+iga_appli_nb_hosts(i)) =     &
00403            cla_appli_hostname(:)     
00404     END IF
00405 
00406     IF (iga_appli_nb_comps(i) .gt. 0) THEN
00407         cga_appli_compname(n_comp+1:n_comp+iga_appli_nb_comps(i)) =  &
00408            cla_appli_compname(:)     
00409         iga_appli_compnbranksets(n_comp+1:n_comp+iga_appli_nb_comps(i)) = &
00410            ila_appli_compnbranksets(:)      
00411     END IF
00412 
00413 ! 3.5.2.4. Increase the index in the global arrays
00414 
00415     n_arg = n_arg + iga_appli_nb_args(i)
00416     n_host = n_host + iga_appli_nb_hosts(i)
00417     n_comp = n_comp + iga_appli_nb_comps(i)
00418 
00419 
00420 ! 3.5.2.5. Deallocate the local arrays
00421 
00422     IF (iga_appli_nb_args(i) .gt. 0) THEN
00423         DEALLOCATE ( cla_appli_args, STAT = id_err ) 
00424         IF (id_err > 0) THEN
00425         ierrp (1) = id_err
00426 
00427         call psmile_error_common ( PRISM_Error_Dealloc, 'Appli args', &
00428            ierrp, 1, __FILE__, __LINE__ )
00429         ENDIF
00430     END IF
00431 
00432     IF (iga_appli_nb_hosts(i) .gt. 0) THEN
00433         DEALLOCATE ( cla_appli_hostname, STAT = id_err ) 
00434         DEALLOCATE ( ila_appli_hostnbprocs, STAT = id_err ) 
00435         IF (id_err > 0) THEN
00436         ierrp (1) = id_err
00437 
00438         call psmile_error_common ( PRISM_Error_Dealloc, 'Appli hosts', &
00439            ierrp, 1, __FILE__, __LINE__ )
00440         ENDIF
00441     END IF
00442 
00443     IF (iga_appli_nb_comps(i) .gt. 0) THEN
00444         DEALLOCATE ( cla_appli_compname, STAT = id_err )
00445         DEALLOCATE ( ila_appli_compnbranksets, STAT = id_err )
00446         IF (id_err > 0) THEN
00447         ierrp (1) = id_err
00448 
00449         call psmile_error_common ( PRISM_Error_Dealloc, 'Appli comps', &
00450            ierrp, 1, __FILE__, __LINE__ )
00451         ENDIF
00452     END IF
00453 
00454       END DO
00455 
00456 #ifdef VERBOSE
00457       PRINT *, '| | Total number of processes: ', ig_nb_tot_pes
00458 #endif
00459       ig_nbtot_ranksets= SUM(iga_appli_nbtot_ranksets(:))
00460 
00461 !
00462 ! 3.6. Allocate and fill the rank sets (min-max-inc) arrays
00463 !
00464 ! 3.6.1. Allocate the rank sets (min-max-inc) arrays
00465 
00466       ALLOCATE ( iga_appli_compranks(ig_nbtot_ranksets,3), STAT = id_err )
00467       IF ( id_err > 0 ) THEN
00468       ierrp (1) = id_err
00469       ierrp (2) = ig_nbtot_ranksets
00470       call psmile_error_common ( PRISM_Error_Alloc, 'Nb tot ranksets', &
00471          ierrp, 2, __FILE__, __LINE__ )
00472       ENDIF
00473 
00474 ! 3.6.2. For all the applications
00475 
00476       n_ranksets = 0
00477 
00478       DO i = 1, ig_nb_appl
00479 
00480 ! 3.6.2.2. Allocate and get the rank sets (min-max-inc) 
00481 !          for all components of one application
00482     IF (iga_appli_nbtot_ranksets(i) .gt. 0) THEN
00483         ALLOCATE ( ila_appli_compranks (iga_appli_nbtot_ranksets(i),3), &
00484            STAT = id_err)
00485         IF ( id_err > 0 ) THEN
00486         ierrp (1) = id_err
00487         ierrp (2) = iga_appli_nbtot_ranksets(i)
00488         call psmile_error_common ( PRISM_Error_Alloc,'Appli nb tot ranksets',&
00489            ierrp, 2, __FILE__, __LINE__ )
00490         ENDIF
00491 
00492         CALL get_applicomprk_detls ( i,  &
00493            iga_appli_nbtot_ranksets(i),  &
00494            ila_appli_compranks,          &
00495            id_err )
00496 
00497             do ii = 1, iga_appli_nbtot_ranksets(i)
00498                
00499                if ( ila_appli_compranks(ii,1) == PSMILE_undef ) then
00500                   id_err = PRISM_Error_Parameter
00501                   ierrp(1) = PSMILe_undef
00502                   ierrp(2) = 0
00503                   call psmile_error_common ( PRISM_Error_Parameter, 'min_value', &
00504                        ierrp, nerrp, __FILE__, __LINE__ )
00505                endif
00506 
00507                if ( ila_appli_compranks(ii,2) < ila_appli_compranks(ii,1) ) then
00508                   ila_appli_compranks(ii,2) = ila_appli_compranks(ii,1)
00509                   PRINT *, '| | WARNING: driver set max_value equal to min_value ', ila_appli_compranks(ii,1) 
00510                endif
00511 
00512                if ( ila_appli_compranks(ii,3) <= 0 ) then
00513                   ila_appli_compranks(ii,3) = 1
00514                   PRINT *, '| | WARNING: driver set incr_value to 1!' 
00515                endif
00516 
00517             enddo
00518 
00519 ! 3.6.2.3. Store it in the global arrays
00520 
00521         iga_appli_compranks(n_ranksets+1:n_ranksets+iga_appli_nbtot_ranksets(i),:)&
00522            = ila_appli_compranks(:,:) 
00523 
00524 ! 3.6.2.4. Increase the index in the global arrays
00525 
00526         n_ranksets = n_ranksets + iga_appli_nbtot_ranksets(i)
00527 
00528 ! 3.6.2.5. Deallocate the local arrays
00529 
00530         DEALLOCATE ( ila_appli_compranks, STAT = id_err )
00531         IF (id_err > 0) THEN
00532         ierrp (1) = id_err
00533 
00534         call psmile_error_common ( PRISM_Error_Dealloc, 'Appli comp ranks', &
00535            ierrp, 1, __FILE__, __LINE__ )
00536         ENDIF
00537 
00538     END IF
00539 
00540       END DO
00541 
00542       ila_scc_info(1) = ig_MPI
00543       ila_scc_info(2) = ig_nb_appl
00544       ila_scc_info(3) = ig_driver_nb_pes
00545       ila_scc_info(4) = ig_nb_tot_comps
00546       ila_scc_info(5) = ig_nbtot_ranksets
00547 
00548       DO i = 1, ig_driver_nb_pes-1
00549 !> WARNING This is a workaround. A comm_drv_local is not yet defined at this point (done in prismdrv_init_appl)
00550 !> The driver processes should have the ranks from PRISMdrv_root to PRISMdrv_root +  ig_driver_nb_pes - 1
00551     CALL MPI_Send(ila_scc_info, 5, MPI_Integer, PRISMdrv_root + i,  0, &
00552        MPI_COMM_WORLD, id_err)
00553       END DO
00554 
00555 !===> Close the XML general configuration file
00556 !
00557 #ifdef CIM
00558       call close_cim_file ()
00559 #else
00560       call close_scc_file ()
00561 #endif
00562 
00563 ! The other pes of the transformer get some info from the master and allocate
00564 ! some structure (the right values are not required in the structure)
00565   ELSE
00566 
00567       CALL MPI_Recv (ila_scc_info, 5, MPI_Integer, PRISMdrv_root, 0, &
00568      MPI_COMM_WORLD, il_status, id_err)
00569 
00570       ig_MPI             = ila_scc_info(1)
00571       ig_nb_appl         = ila_scc_info(2)
00572       ig_driver_nb_pes   = ila_scc_info(3)
00573       ig_nb_tot_comps    = ila_scc_info(4)
00574       ig_nbtot_ranksets  = ila_scc_info(5)
00575 
00576       ALLOCATE ( comm_coupling(0:ig_nb_appl), STAT = id_err )
00577       IF ( id_err > 0 ) THEN
00578       ierrp (1) = id_err
00579       ierrp (2) = ig_nb_appl
00580       call psmile_error_common ( PRISM_Error_Alloc, 'comm_coupling', &
00581          ierrp, 2, __FILE__, __LINE__ )
00582       ENDIF
00583 
00584       ALLOCATE ( iga_appli_nb_pes(0:ig_nb_appl), STAT = id_err )
00585       IF ( id_err > 0 ) THEN
00586       ierrp (1) = id_err
00587       ierrp (2) = ig_nb_appl
00588       call psmile_error_common ( PRISM_Error_Alloc, 'iga_appli_nb_pes', &
00589          ierrp, 2, __FILE__, __LINE__ )
00590       ENDIF
00591       iga_appli_nb_pes(:) = 0
00592 
00593       ALLOCATE ( cga_appli_name(0:ig_nb_appl), STAT = id_err )
00594       IF ( id_err > 0 ) THEN
00595       ierrp (1) = id_err
00596       ierrp (2) = ig_nb_appl
00597       call psmile_error_common ( PRISM_Error_Alloc, 'cga_appli_name', &
00598          ierrp, 2, __FILE__, __LINE__ )
00599       ENDIF
00600       cga_appli_name(:) = 'trans'
00601 
00602       ALLOCATE ( iga_appli_nb_comps(0:ig_nb_appl), STAT = id_err )
00603       IF ( id_err > 0 ) THEN
00604       ierrp (1) = id_err
00605       ierrp (2) = ig_nb_appl
00606       call psmile_error_common ( PRISM_Error_Alloc, 'iga_appli_nb_comps', &
00607          ierrp, 2, __FILE__, __LINE__ )
00608       ENDIF
00609       iga_appli_nb_comps(:) = 0
00610 
00611       ALLOCATE ( cga_appli_compname(ig_nb_tot_comps), STAT = id_err )
00612       IF ( id_err > 0 ) THEN
00613       ierrp (1) = id_err
00614       ierrp (2) = ig_nb_tot_comps
00615       call psmile_error_common ( PRISM_Error_Alloc, 'cga_appli_compname', &
00616          ierrp, 2, __FILE__, __LINE__ )
00617       ENDIF
00618       ALLOCATE ( iga_appli_redirect(0:ig_nb_appl), STAT = id_err )
00619       IF ( id_err > 0 ) THEN
00620       ierrp (1) = id_err
00621       ierrp (2) = ig_nb_appl
00622       call psmile_error_common ( PRISM_Error_Alloc, 'iga_appli_redirect', &
00623          ierrp, 2, __FILE__, __LINE__ )
00624       ENDIF
00625 
00626       ALLOCATE ( iga_appli_compnbranksets(ig_nb_tot_comps), STAT = id_err )
00627       IF ( id_err > 0 ) THEN
00628       ierrp (1) = id_err
00629       ierrp (2) = ig_nb_tot_comps
00630       call psmile_error_common ( PRISM_Error_Alloc, 'iga_appli_compnbranksets', &
00631          ierrp, 2, __FILE__, __LINE__ )
00632       ENDIF
00633       ALLOCATE ( iga_appli_compranks(ig_nbtot_ranksets,3), STAT = id_err )
00634       IF ( id_err > 0 ) THEN
00635       ierrp (1) = id_err
00636       ierrp (2) = ig_nbtot_ranksets
00637       call psmile_error_common ( PRISM_Error_Alloc, 'Nb tot ranksets', &
00638          ierrp, 2, __FILE__, __LINE__ )
00639       ENDIF
00640 
00641 
00642   END IF
00643 !
00644 #ifdef VERBOSE
00645   PRINT *, '| Quit PRISMDrv_set_scc_info'
00646   PRINT *, '|'
00647   call psmile_flushstd
00648 #endif
00649 END SUBROUTINE PRISMDrv_set_scc_info
00650 
00651 
00652 
00653 

Generated on 1 Dec 2011 for Oasis4 by  doxygen 1.6.1