psmile_init_mpi1.F90

Go to the documentation of this file.
00001 !-----------------------------------------------------------------------
00002 ! Copyright 2006-2010, NEC Europe Ltd., London, UK.
00003 ! All rights reserved. Use is subject to OASIS4 license terms.
00004 !-----------------------------------------------------------------------
00005 !BOP
00006 !
00007 ! !ROUTINE: PSMILe_Init_MPI1
00008 !
00009 ! !INTERFACE:
00010 !
00011       subroutine psmile_init_mpi1 (ierror)
00012 
00013 !
00014 ! !USES:
00015 !
00016       use PRISM_constants
00017       use PSMILe, dummy_interface => PSMILe_Init_MPI1
00018 #ifdef CIM
00019       USE PSMILe_cim
00020 #else
00021       USE PSMILe_scc
00022 #endif
00023 
00024       implicit none
00025 !
00026 ! !OUTPUT PARAMETERS:
00027 !
00028       integer, Intent (Out) :: ierror
00029 
00030 !     Returns the error code of PSMILe_Init_MPI1;
00031 !             ierror = 0 : No error
00032 !             ierror > 0 : Severe error
00033 !
00034 ! !LOCAL VARIABLES
00035 !
00036       integer            :: index, il_myint
00037       integer            :: global_size
00038       integer, parameter :: ndibuf = 3
00039       integer            :: ibuf (ndibuf)
00040 
00041       integer, parameter :: nerrp = 2
00042       integer            :: ierrp (nerrp)
00043 
00044       integer, dimension(15) :: idate
00045       double precision, dimension(3) :: ddate
00046 
00047       Type(PRISM_Time_Struct) :: tdate
00048       INTEGER            :: noHosts(0:1), noArgs(0:1)
00049 
00050       integer, parameter :: rank_dummy = huge(il_myint)
00051 
00052       integer, allocatable :: appl_redirect(:)
00053       character (len=max_name) :: cpatch(0:1)
00054 !
00055 ! !DESCRIPTION:
00056 !
00057 !
00058 ! Subroutine "PSMILe_Init_MPI1" receives the initial data sent by
00059 ! the master process of the coupler and defines the communicators
00060 ! if all processes were simultaneously started by the mpirun/mpiexec
00061 ! command.
00062 !
00063 !
00064 ! !REVISION HISTORY:
00065 !
00066 !   Date      Programmer   Description
00067 ! ----------  ----------   -----------
00068 ! 01.12.03    R. Redler    created
00069 !
00070 !EOP
00071 !----------------------------------------------------------------------
00072 !
00073 ! $Id: psmile_init_mpi1.F90 3248 2011-06-23 13:03:19Z coquart $
00074 ! $Author: coquart $
00075 !
00076       character(len=len_cvs_string), save :: mycvs = 
00077       '$Id: psmile_init_mpi1.F90 3248 2011-06-23 13:03:19Z coquart $'
00078 !
00079 ! ---------------------------------------------------------------------
00080 
00081 #ifdef VERBOSE
00082       print *, trim(ch_id), ': PSMILe_Init_MPI1: start'
00083 #endif /* VERBOSE */
00084 
00085 !     determines PRISMdrv_root process
00086 !     components provide only a dummy argument
00087 !     the MPI_Allreduce call matches a call in prismdrv_init.F90
00088 
00089       call MPI_Allreduce ( rank_dummy, PRISMdrv_root, 1, MPI_Integer, MPI_MIN, MPI_COMM_WORLD, ierror )
00090 
00091       if ( ierror /= MPI_SUCCESS ) then
00092          ierrp (1) = ierror
00093          ierror = PRISM_Error_MPI
00094 
00095          call psmile_error ( ierror, 'MPI_Allreduce', &
00096                              ierrp, 1, __FILE__, __LINE__ )
00097          return
00098       endif
00099 
00100 !     if there is no driver process
00101       if ( PRISMdrv_root == rank_dummy ) then
00102 !        stand alone case => set component process with rank 0 as root
00103          PRISMdrv_root = 0
00104       endif
00105 
00106 !===> Create global communicator
00107 !     This is simply a duplicate of MPI_COMM_WORLD.
00108 
00109       call MPI_Comm_dup ( MPI_COMM_WORLD, comm_global, ierror )
00110 
00111       if ( ierror /= MPI_SUCCESS ) then
00112          ierrp (1) = ierror
00113          ierror = PRISM_Error_MPI
00114 
00115          call psmile_error ( ierror, 'MPI_Comm_dup', &
00116                              ierrp, 1, __FILE__, __LINE__ )
00117          return
00118       endif
00119 
00120       call MPI_Comm_rank ( comm_global, global_rank, ierror )
00121 
00122       if ( ierror /= MPI_SUCCESS ) then
00123          ierrp (1) = ierror
00124          ierror = PRISM_Error_MPI
00125 
00126          call psmile_error ( ierror, 'MPI_Comm_rank', &
00127                             ierrp, 1, __FILE__, __LINE__ )
00128          return
00129       endif
00130 
00131       call MPI_Comm_size ( comm_global, global_size, ierror )
00132 
00133       if ( ierror /= MPI_SUCCESS ) then
00134          ierrp (1) = ierror
00135          ierror = PRISM_Error_MPI
00136 
00137          call psmile_error ( ierror, 'MPI_Comm_size', &
00138                              ierrp, 1, __FILE__, __LINE__ )
00139          return
00140       endif
00141 !
00142 !===> Duplicate comm_global to get comm_trans
00143 !
00144       call MPI_Comm_dup (comm_global, comm_trans, ierror)
00145 
00146       if ( ierror /= MPI_SUCCESS ) then
00147          ierrp (1) = ierror
00148          ierror = PRISM_Error_MPI
00149 
00150          call psmile_error ( ierror, 'MPI_Comm_dup', &
00151                              ierrp, 1, __FILE__, __LINE__ )
00152          return
00153       endif
00154 
00155 ! ---------------------------------------------------------------------
00156 !     Get protocol version for communication between the coupler
00157 !     and the applications (set of components)
00158 ! ---------------------------------------------------------------------
00159 
00160       call MPI_Allreduce (PSMILe_latest_protocol_version, protocol_version, &
00161                           1, MPI_Integer, MPI_MIN, comm_global,  &
00162                           ierror)
00163 
00164       if ( ierror /= MPI_SUCCESS ) then
00165          ierrp (1) = ierror
00166          ierror = PRISM_Error_MPI
00167 
00168          call psmile_error ( ierror, 'MPI_Allreduce', &
00169                              ierrp, 1, __FILE__, __LINE__ )
00170          return
00171       endif
00172 
00173       if (  protocol_version < PSMILe_latest_protocol_version) then
00174 
00175          write (*, 9990) protocol_version, PSMILe_latest_protocol_version
00176          call psmile_assert ( __FILE__, __LINE__, &
00177            'impossible protocol versions computed')
00178 
00179 9990 format (/1x, 'PSMILe_Init_MPI1: protocol_version =', i7, &
00180                  '; latest =', i7)
00181       endif
00182 
00183 ! ---------------------------------------------------------------------
00184 !     Get initial data from the root of coupler processes and broadcast
00185 !     data to the processes of the applications. Corresponding Driver
00186 !     MPI_Bcast calls are located in PRISMDrv_Init_appl.
00187 ! ---------------------------------------------------------------------
00188 !
00189 !===> Number of applications is distributed to all processes
00190 !     The data is sent by the root of the coupler processes.
00191 !
00192       if (global_rank == PRISMdrv_root) then
00193 !
00194 !        PSMILe is running without a driver.
00195 !
00196          noApplication = 1
00197 
00198 !        Number of components is set to 1 here. For stand_alone
00199 !        applications it will be redefined later.
00200 
00201          noComponents = 1
00202 
00203          ibuf (1) = noApplication
00204          ibuf (2) = noComponents
00205          ibuf (3) = 1 ! Indicating stand alone
00206       endif
00207 
00208       call MPI_Bcast( ibuf, ndibuf, MPI_Integer, &
00209                       PRISMdrv_root, comm_global, ierror )
00210 
00211       if ( ierror /= MPI_SUCCESS ) then
00212          ierrp (1) = ierror
00213          ierror = PRISM_Error_MPI
00214 
00215          call psmile_error ( ierror, 'MPI_Bcast', &
00216                              ierrp, 1, __FILE__, __LINE__ )
00217          return
00218       endif
00219 
00220       noApplication = ibuf (1)
00221       noComponents  = ibuf (2)
00222       Appl%stand_alone = ibuf (3) .eq. 1
00223 
00224 #ifdef PRISM_ASSERTION
00225       if (  noApplication < 1 ) then
00226          call psmile_assert ( __FILE__, __LINE__, &
00227              'Number of Application should be > 0!')
00228       endif
00229 
00230       if ( noComponents < noApplication  ) then
00231          call psmile_assert ( __FILE__, __LINE__, &
00232              'Number of Components should be >= Number of Applications!')
00233       endif
00234 
00235       if ( ibuf(3) < 0 .or. ibuf (3) > 1 ) then
00236          call psmile_assert ( __FILE__, __LINE__, &
00237              'Stand alone flag should be 0 or 1!')
00238       endif
00239 #endif
00240 
00241       if ( Appl%stand_alone ) then
00242          print *, trim(ch_id), ': PSMILe_Init_MPI1: Assuming stand alone run!'
00243       endif
00244 !
00245 !===> Allocate global vectors
00246 !
00247       Allocate (PRISM_applProc (0:noApplication), STAT = ierror)
00248 
00249       if ( ierror > 0 ) then
00250          ierrp (1) = ierror
00251          ierrp (2) = noApplication + 1
00252 
00253          ierror = PRISM_Error_Alloc
00254          call psmile_error ( ierror, 'PRISM_applProc', &
00255                              ierrp, 2, __FILE__, __LINE__ )
00256          return
00257       endif
00258 
00259       Allocate (PRISM_applName (0:noApplication), STAT = ierror)
00260 
00261       if ( ierror > 0 ) then
00262          ierrp (1) = ierror
00263          ierrp (2) = noApplication + 1
00264 
00265          ierror = PRISM_Error_Alloc
00266          call psmile_error ( ierror, 'PRISM_applName', &
00267                              ierrp, 2, __FILE__, __LINE__ )
00268          return
00269       endif
00270 
00271       PRISM_applName(:) = ' '
00272 !
00273 !===> Initialize data for stand alone application
00274 !
00275       if ( Appl%stand_alone ) then
00276 
00277          PRISM_applProc(0) = 0
00278          PRISM_applProc(1) = global_size
00279 
00280          PRISM_applName(0) = 'Stand alone'
00281          PRISM_applName(1) = trim(Appl%name)
00282 
00283 !
00284 !===> open the XML general configuration file and load its elements into memory
00285 !
00286 #ifdef CIM
00287          call open_cim_file (ierror)
00288 #else
00289          call open_scc_file (ierror)
00290 #endif
00291          IF ( ierror > 0 ) THEN
00292              call PSMILe_Abort
00293          ENDIF
00294 !
00295 !===> get_execution_mode
00296 !
00297          call get_execution_mode (ierror, ierror)
00298 
00299 !
00300 !===> get the dates
00301 !
00302          call get_dates (PRISM_initial_date, tdate, &
00303         PRISM_Jobstart_date, PRISM_Jobend_date, ierror)
00304 
00305 !
00306 !===> Allocate and get the number of components per application
00307 !
00308          Allocate (PRISM_noCompsPerAppl (0:1), STAT = ierror)
00309 
00310          if ( ierror > 0 ) then
00311             ierrp (1) = ierror
00312             ierrp (2) = 1
00313 
00314             ierror = PRISM_Error_Alloc
00315             call psmile_error ( ierror, 'PRISM_noCompsPerAppl', &
00316                                 ierrp, 2, __FILE__, __LINE__ )
00317             return
00318          endif
00319 
00320          call get_appli_details ( 1, PRISM_applName, cpatch,  &
00321                               noHosts, PRISM_Redirect,      &
00322                                   PRISM_noCompsPerAppl,      &
00323                                   noArgs, ierror )
00324 !
00325 !===> Allocate and get the components name and the number of rank sets per comp
00326 !
00327          Allocate (PRISM_compName (1:PRISM_noCompsPerAppl(1)), STAT = ierror)
00328 
00329          if ( ierror > 0 ) then
00330             ierrp (1) = ierror
00331             ierrp (2) = PRISM_noCompsPerAppl(1)
00332 
00333             ierror = PRISM_Error_Alloc
00334             call psmile_error ( ierror, 'PRISM_compName', &
00335                              ierrp, 2, __FILE__, __LINE__ )
00336             return
00337          endif
00338 
00339          Allocate(PRISM_compRankSets(1:PRISM_noCompsPerAppl(1)), STAT = ierror)
00340 
00341          if ( ierror > 0 ) then
00342             ierrp (1) = ierror
00343             ierrp (2) = PRISM_noCompsPerAppl(1)
00344 
00345             ierror = PRISM_Error_Alloc
00346             call psmile_error ( ierror, 'PRISM_compRankSets', &
00347                                 ierrp, 2, __FILE__, __LINE__ )
00348             return
00349          endif
00350 
00351      call get_applicomp_details ( 1, PRISM_noCompsPerAppl(1), &
00352         PRISM_compName, PRISM_compRankSets, ierror)
00353 
00354 !
00355 !===> Allocate and get the rank sets per component
00356 !
00357          noRanksets = sum(PRISM_compRankSets(:))
00358          Allocate (PRISM_rankSets (noRanksets,3), STAT = ierror)
00359 
00360          if ( ierror > 0 ) then
00361             ierrp (1) = ierror
00362             ierrp (2) = noRanksets
00363 
00364             ierror = PRISM_Error_Alloc
00365             call psmile_error ( ierror, 'PRISM_rankSets', &
00366                                 ierrp, 2, __FILE__, __LINE__ )
00367             return
00368          endif
00369 
00370      call get_applicomprk_detls ( 1, noRanksets,  &
00371            PRISM_rankSets, ierror)
00372 
00373          do index = 1, noRanksets
00374             PRISM_rankSets(index,3) = max(1,PRISM_rankSets(index,3))
00375             PRISM_rankSets(index,2) = max(PRISM_rankSets(index,1),PRISM_rankSets(index,2))
00376          enddo
00377 
00378          index = 1
00379 
00380 !===> Close the XML general configuration file and free memory
00381 !
00382 #ifdef CIM
00383          call close_cim_file ()
00384 #else
00385          call close_scc_file ()
00386 #endif
00387       
00388       else ! Appl%stand_alone
00389 
00390 
00391 
00392 !
00393 !===> Allocate global vector specific for coupled runs
00394 !
00395       Allocate (PRISM_noCompsPerAppl (0:noApplication), STAT = ierror)
00396 
00397       if ( ierror > 0 ) then
00398          ierrp (1) = ierror
00399          ierrp (2) = noApplication
00400 
00401          ierror = PRISM_Error_Alloc
00402          call psmile_error ( ierror, 'PRISM_noCompsPerAppl', &
00403                              ierrp, 2, __FILE__, __LINE__ )
00404          return
00405       endif
00406 
00407       Allocate (PRISM_compName (1:noComponents), STAT = ierror)
00408 
00409       if ( ierror > 0 ) then
00410          ierrp (1) = ierror
00411          ierrp (2) = noComponents
00412 
00413          ierror = PRISM_Error_Alloc
00414          call psmile_error ( ierror, 'PRISM_compName', &
00415                              ierrp, 2, __FILE__, __LINE__ )
00416          return
00417       endif
00418 !
00419 !===> Number of processes per application is distributed to all processes
00420 !     Note: This is only used in order to ensure that at least one process
00421 !     was assigne to the coupler.
00422 !
00423 !
00424 !===> Number of processes per application is distributed to all processes
00425 !
00426          call MPI_Bcast( PRISM_applProc(0), noApplication+1, MPI_Integer, &
00427                          PRISMdrv_root, comm_global, ierror )
00428 
00429          if ( ierror /= MPI_SUCCESS ) then
00430             ierrp (1) = ierror
00431             ierror = PRISM_Error_MPI
00432             call psmile_error ( ierror, 'MPI_Bcast', ierrp, 1, &
00433                                 __FILE__, __LINE__ )
00434             return
00435          endif
00436 
00437 #ifdef PRISM_ASSERTION
00438          if ( PRISM_applProc(0) < 1 ) then
00439             call psmile_assert ( __FILE__, __LINE__, &
00440                 'Coupler should be assigned to at least 1 processor!')
00441          endif
00442 
00443          if (  noApplication < 1 ) then
00444             call psmile_assert ( __FILE__, __LINE__, &
00445                 'Number of Application should be > 0!')
00446          endif
00447 #endif
00448 
00449 ! ---------------------------------------------------------------------
00450 !     Get names of applications
00451 ! ---------------------------------------------------------------------
00452 
00453 !
00454 !===> Broadcast names of all applications
00455 !
00456          call MPI_Bcast( PRISM_applName(0), (noApplication+1)*max_name, &
00457                          MPI_Character, &
00458                          PRISMdrv_root, comm_global, ierror )
00459 
00460          if ( ierror /= MPI_SUCCESS ) then
00461             ierrp (1) = ierror
00462             ierror = PRISM_Error_MPI
00463             call psmile_error ( ierror, 'MPI_Bcast', ierrp, 1, &
00464                                 __FILE__, __LINE__ )
00465             return
00466          endif
00467 !
00468 !===> Detect Sequence number of application in the set,
00469 !     can be used for coloring in psmile_def_mpi_comm as well
00470 !     It is checked whether Appl%name appears in the list that
00471 !     is received from the transformer. If the name is not found
00472 !     we terminate the application in PSMILe_Error.
00473 !
00474 #ifdef VERBOSE
00475          do index = 1, noApplication
00476             print *, trim(ch_id), ': ', index, &
00477                         'name of the application:         ', trim(Appl%name)
00478             print *, trim(ch_id), ': ', index, &
00479                         'compared to name given in PMIOD: ', trim(PRISM_applName(index))
00480          enddo
00481 #endif
00482          index = 1
00483 
00484          do while ((trim(Appl%name) /= trim(PRISM_applName(index))) &
00485                     .and. index <=  noApplication)
00486             index = index + 1
00487          enddo
00488 
00489          if ( index > noApplication ) then
00490             ierrp (1) = noApplication
00491             ierrp (2) = index
00492  
00493             call PSMILe_Error ( ierror, Appl%name, ierrp, 2, &
00494                                 __FILE__, __LINE__ )
00495             return
00496          endif
00497 
00498          Appl%sequence_number = index
00499 !
00500 !===> Broadcast names of all components
00501 !
00502          call MPI_Bcast( PRISM_compName(1), noComponents*max_name, &
00503                          MPI_Character, &
00504                          PRISMdrv_root, comm_global, ierror )
00505 
00506          if ( ierror /= MPI_SUCCESS ) then
00507             ierrp (1) = ierror
00508             ierror = PRISM_Error_MPI
00509             call psmile_error ( ierror, 'MPI_Bcast', ierrp, 1, &
00510                                 __FILE__, __LINE__ )
00511             return
00512          endif
00513 !
00514 !===> Broadcast the number of components of all applications
00515 !
00516          call MPI_Bcast( PRISM_noCompsPerAppl(1), noApplication, &
00517                          MPI_Integer, &
00518                          PRISMdrv_root, comm_global, ierror )
00519 
00520          if ( ierror /= MPI_SUCCESS ) then
00521             ierrp (1) = ierror
00522             ierror = PRISM_Error_MPI
00523             call psmile_error ( ierror, 'MPI_Bcast', ierrp, 1, &
00524                                 __FILE__, __LINE__ )
00525             return
00526          endif
00527 
00528 !
00529 !===> Allocate and broadcast the number of rank sets for the components
00530 !     and the ranksets
00531 
00532          Allocate (PRISM_compRankSets (1:noComponents), STAT = ierror)
00533 
00534          if ( ierror > 0 ) then
00535             ierrp (1) = ierror
00536             ierrp (2) = noComponents
00537 
00538             ierror = PRISM_Error_Alloc
00539             call psmile_error ( ierror, 'PRISM_compRankSets', &
00540                  ierrp, 2, __FILE__, __LINE__ )
00541             return
00542          endif
00543 
00544          call MPI_Bcast( PRISM_compRankSets(1), noComponents, &
00545               MPI_Integer, &
00546               PRISMdrv_root, comm_global, ierror )
00547 
00548          if ( ierror /= MPI_SUCCESS ) then
00549             ierrp (1) = ierror
00550             ierror = PRISM_Error_MPI
00551             call psmile_error ( ierror, 'MPI_Bcast', ierrp, 1, &
00552                  __FILE__, __LINE__ )
00553             return
00554          endif
00555 
00556          noRanksets = sum(PRISM_compRankSets(:))
00557          Allocate (PRISM_rankSets (noRanksets,3), STAT = ierror)
00558 
00559          if ( ierror > 0 ) then
00560             ierrp (1) = ierror
00561             ierrp (2) = noRanksets
00562 
00563             ierror = PRISM_Error_Alloc
00564             call psmile_error ( ierror, 'PRISM_rankSets', &
00565                  ierrp, 2, __FILE__, __LINE__ )
00566             return
00567          endif
00568 
00569          call MPI_Bcast( PRISM_rankSets(1,1), noRanksets*3, &
00570               MPI_Integer, &
00571               PRISMdrv_root, comm_global, ierror )
00572 
00573          if ( ierror /= MPI_SUCCESS ) then
00574             ierrp (1) = ierror
00575             ierror = PRISM_Error_MPI
00576             call psmile_error ( ierror, 'MPI_Bcast', ierrp, 1, &
00577                  __FILE__, __LINE__ )
00578             return
00579          endif
00580 !
00581 !===> Allocate and broadcast redirect info
00582 !
00583          Allocate ( appl_redirect(noApplication), STAT = ierror)
00584          if ( ierror > 0 ) then
00585             ierrp (1) = ierror
00586             ierrp (2) = noApplication
00587             ierror = PRISM_Error_Alloc
00588             call psmile_error ( ierror, 'appl_redirect', &
00589                  ierrp, 2, __FILE__, __LINE__ )
00590             return
00591          endif
00592 
00593          call MPI_Bcast( appl_redirect, noApplication, &
00594               MPI_Integer, PRISMdrv_root, comm_global, ierror )
00595 
00596          if ( ierror /= MPI_SUCCESS ) then
00597             ierrp (1) = ierror
00598             ierror = PRISM_Error_MPI
00599             call psmile_error ( ierror, 'MPI_Bcast', ierrp, 1, &
00600                  __FILE__, __LINE__ )
00601             return
00602          endif
00603 
00604          PRISM_Redirect(1) = appl_redirect(Appl%sequence_number)
00605 
00606          Deallocate ( appl_redirect, STAT = ierror)
00607          if ( ierror > 0 ) then
00608             ierrp (1) = ierror
00609             ierrp (2) = noApplication
00610             ierror = PRISM_Error_Dealloc
00611             call psmile_error ( ierror, 'appl_redirect', &
00612                  ierrp, 2, __FILE__, __LINE__ )
00613             return
00614          endif
00615 
00616       endif ! Appl%stand_alone
00617 !
00618 !===> The correct calling sequence of PRISM_init and PRISM_init_comp
00619 !      for multi-component applications is checked. In case PRISM_init
00620 !      is not called explicitly before any call to PRISM_init_comp for
00621 !      applications containing more than one component we terminate in
00622 !      PSMILe_Error.
00623 !
00624       if ( PRISM_noCompsPerAppl(index) > 1 .and. PRISM_comp_init ) then
00625             ierror = PRISM_Error_InitApp
00626             ierrp (1) = PRISM_noCompsPerAppl(index)
00627             call psmile_error ( ierror, 'Explicit call to PRISM_Init required', &
00628                                ierrp, 1, __FILE__, __LINE__ )
00629          return
00630       endif
00631 
00632 !===> Create communicators for applications and alike
00633 
00634       call psmile_def_mpi_comm (ierror)
00635       if (ierror /= 0) return
00636 
00637       if ( PRISM_ApplProc(index) /= Appl%size ) then
00638 
00639          ierror = PRISM_Error_InitApp
00640          ierrp (1) = PRISM_ApplProc(index)
00641          ierrp (2) = Appl%size
00642 
00643          call psmile_error ( ierror, &
00644                'Inconsistent mpirun command and scc.xml', ierrp, 2, &
00645                              __FILE__, __LINE__ )
00646          return
00647       endif
00648 
00649       if ( .not. Appl%stand_alone ) then
00650 !
00651 !===> Broadcast the run start date and the experiment start date
00652 !     and fill up internal structure. The first half corresponds
00653 !     to the start of the run, the second half corresponds to the
00654 !     start of the experiment.
00655 !
00656          call MPI_Bcast( idate(1), 15, &
00657               MPI_Integer, PRISMdrv_root, comm_global, ierror )
00658 
00659          if ( ierror /= MPI_SUCCESS ) then
00660             ierrp (1) = ierror
00661             ierror = PRISM_Error_MPI
00662             call psmile_error ( ierror, 'MPI_Bcast', ierrp, 1, &
00663                  __FILE__, __LINE__ )
00664             return
00665          endif
00666 
00667          call MPI_Bcast( ddate(1), 3, &
00668               MPI_Double_Precision, PRISMdrv_root, comm_global, ierror )
00669 
00670          if ( ierror /= MPI_SUCCESS ) then
00671             ierrp (1) = ierror
00672             ierror = PRISM_Error_MPI
00673             call psmile_error ( ierror, 'MPI_Bcast', ierrp, 1, &
00674                  __FILE__, __LINE__ )
00675             return
00676          endif
00677 
00678          PRISM_Jobstart_date%year   = idate(1)
00679          PRISM_Jobstart_date%month  = idate(2)
00680          PRISM_Jobstart_date%day    = idate(3)
00681          PRISM_Jobstart_date%hour   = idate(4)
00682          PRISM_Jobstart_date%minute = idate(5)
00683          PRISM_Jobstart_date%second = ddate(1)
00684 
00685          PRISM_Jobend_date%year   = idate(6)
00686          PRISM_Jobend_date%month  = idate(7)
00687          PRISM_Jobend_date%day    = idate(8)
00688          PRISM_Jobend_date%hour   = idate(9)
00689          PRISM_Jobend_date%minute = idate(10)
00690          PRISM_Jobend_date%second = ddate(2)
00691 
00692          PRISM_initial_date%year   = idate(11)
00693          PRISM_initial_date%month  = idate(12)
00694          PRISM_initial_date%day    = idate(13)
00695          PRISM_initial_date%hour   = idate(14)
00696          PRISM_initial_date%minute = idate(15)
00697          PRISM_initial_date%second = ddate(3)
00698 
00699       endif
00700 
00701 !===> All done
00702 
00703       ierror = 0
00704 
00705 #ifdef VERBOSE
00706       print *, trim(ch_id), ': PSMILe_Init_MPI1: eof ierror =', ierror
00707 #endif /* VERBOSE */
00708 
00709       end subroutine PSMILe_Init_MPI1