prismdrv_init.F90

Go to the documentation of this file.

!------------------------------------------------------------------------
! Copyright 2006-2010, CERFACS, Toulouse, France.
! All rights reserved. Use is subject to OASIS4 license terms.
!-----------------------------------------------------------------------
!BOP
!
! !ROUTINE: PRISMDrv_Init
!
! !INTERFACE
subroutine prismdrv_init(id_err)

!
! !USES:
!
  USE PRISMDrv, dummy_interface => PRISMDrv_Init
!

  IMPLICIT NONE
!
! !PARAMETERS:
!

!
! ! RETURN VALUE
!
  INTEGER, INTENT (Out)               :: id_err   ! error value

! !DESCRIPTION
! Subroutine "PRISMDrv_Init" initializes the MPI context of the driver 
! application and open the dedicated local output files
!
! !REVISED HISTORY
!   Date      Programmer   Description
! ----------  ----------   -----------
! 03/10/2002  D. Declat    Creation
!
! EOP
!----------------------------------------------------------------------
! $Id: prismdrv_init.F90 2791 2010-12-01 16:37:57Z hanke $
! $Author: hanke $
!----------------------------------------------------------------------
!
! Local declarations
!
  CHARACTER(LEN=len_cvs_string), SAVE  :: mycvs = 
     '$Id: prismdrv_init.F90 2791 2010-12-01 16:37:57Z hanke $'

  LOGICAL                             :: ll_flag

  INTEGER, PARAMETER                  :: nerrp=2
  INTEGER                             :: ierrp(nerrp)

  INTEGER                             :: il_length, il_ndibuf
  INTEGER, DIMENSION(:), ALLOCATABLE  :: ila_ibuf  

  INTEGER                             :: il_pos = 0

! ---------------------------------------------------------------------
!
!
! 0. Initialisation of constants (see also subroutine prism_init)
!
      real_pi = atan (1.0) * 4.0
      real_pi2 = 2.0 * real_pi
      real_pih = real_pi * 0.5
      real_deg2rad = real_pi / 180.0
!
      dble_pi = atan (1.0d0) * 4.0d0
      dble_pi2 = 2.0d0 * dble_pi
      dble_pih = dble_pi * 0.5d0
      dble_deg2rad = dble_pi / 180.0d0
!
! 0.1 Initialisation of variables contained in PRISMDrv module
!
      ig_nbtot_ranksets = 0 
      sga_experiment_start_date%second = 0.0d0
      sga_experiment_start_date%minute = 0
      sga_experiment_start_date%hour   = 0
      sga_experiment_start_date%day    = 0
      sga_experiment_start_date%month  = 0
      sga_experiment_start_date%year   = 0
      sga_experiment_end_date%second = 0.0d0
      sga_experiment_end_date%minute = 0
      sga_experiment_end_date%hour   = 0
      sga_experiment_end_date%day    = 0
      sga_experiment_end_date%month  = 0
      sga_experiment_end_date%year   = 0
      sga_run_start_date%second = 0.0d0
      sga_run_start_date%minute = 0
      sga_run_start_date%hour   = 0
      sga_run_start_date%day    = 0
      sga_run_start_date%month  = 0
      sga_run_start_date%year   = 0
      sga_run_end_date%second = 0.0d0
      sga_run_end_date%minute = 0
      sga_run_end_date%hour   = 0
      sga_run_end_date%day    = 0
      sga_run_end_date%month  = 0
      sga_run_end_date%year   = 0
!
      ig_driver_nb_pes  = 0
      ig_nb_appl        = 0
      ig_nb_tot_pes     = 0    
      ig_nb_tot_hosts   = 0   
      ig_nb_tot_comps   = 0   
      ig_nb_tot_args    = 0  
!
      ig_nb_tot_unitsets= 0 
      ig_nb_tot_grids   = 0 
      ig_nb_tot_transi  = 0 
      ig_nb_tot_persis  = 0 
!
      ig_MPI            = 0
      comm_drv_global   = 0    
      comm_drv_local    = 0   
      comm_drv_psmile   = 0   
      driver_rank       = -1
      comm_drv_trans    = 0
!
      Number_of_Grids_drv       = 0       
      Number_of_Epios_allocated = 0 
      Number_of_comms           = 0      
      Number_of_Interps         = 0      
      Number_of_Transfs         = 0 
      Number_of_Exchanges       = 0 
!
!
! 1. Initialize MPI
!
  CALL MPI_Initialized ( ll_flag, id_err )

  IF (.NOT. ll_flag) THEN
        
      CALL MPI_Init (id_err)

      IF ( id_err /= MPI_SUCCESS ) THEN
          ierrp (1) = id_err
!          CALL PSMILe_Error_Common ( PRISM_Error_MPI, 'MPI_Init', &
!             ierrp, 1, __FILE__, __LINE__ )
          RETURN
      ENDIF

  ENDIF

  Appl%name = 'driver'

  CALL MPI_COMM_RANK ( MPI_COMM_WORLD, Appl%rank, id_err )
  
  IF ( id_err /= MPI_SUCCESS ) THEN
      ierrp (1) = id_err
      call psmile_error_common ( PRISM_Error_MPI, 'MPI_Comm_rank', &
         ierrp, 1, __FILE__, __LINE__ )
      RETURN
  ENDIF

! determine PRISMdrv_root
  CALL MPI_ALLREDUCE(Appl%rank, PRISMdrv_root, 1, MPI_Integer, MPI_MIN, MPI_COMM_WORLD, id_err)

  IF ( id_err /= MPI_SUCCESS ) THEN
      ierrp (1) = id_err
      call psmile_error_common ( PRISM_Error_MPI, 'MPI_Allreduce', &
         ierrp, 1, __FILE__, __LINE__ )
      RETURN
  ENDIF

!
! 2. Open local output files
!
  il_length = 6
  length_of_integer = BIT_SIZE (datatypes2mpi (1)) / 8
  il_ndibuf = il_length / length_of_integer + 1

  ALLOCATE (ila_ibuf(1:il_ndibuf), STAT = id_err)
  IF ( id_err > 0 ) THEN
      ierrp (1) = id_err
      ierrp (2) = il_ndibuf
      call psmile_error_common ( PRISM_Error_Alloc, 'ila_ibuf', &
         ierrp, 2, __FILE__, __LINE__ )
      RETURN
  ENDIF

#ifdef NAG_COMPILER
         call psmile_redirstdout ( 'driver', il_length, &
                                   1,  Appl%rank, Appl%size, id_err)
#else
  call psmile_char2buf(ila_ibuf, il_ndibuf, il_pos, 'driver')
  call psmile_redirstdout(ila_ibuf, il_length, 1, Appl%rank, Appl%size, id_err)
#endif
!
#ifdef VERBOSE
  PRINT *, '|'
  PRINT *, '| Enter PRISMDrv_Init'

  PRINT *, '| Quit PRISMDrv_Init'
  PRINT *, '|'
  call psmile_flushstd
#endif
END SUBROUTINE PRISMDrv_Init