modd_surfex_mpi.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     ######################
      MODULE modd_surfex_mpi
!     ######################
!
!!****  *MODD_SURFEX_MPI
!!
!!    PURPOSE
!!    -------
!
!!
!!**  IMPLICIT ARGUMENTS
!!    ------------------
!!      None 
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!      S. Faroux   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original       04/06/12
!!      B. Decharme    04/2013  Delete NWG_LAYER_TOT, NWG_SIZE
!!      J.Escobar      10/06/2013: replace DOUBLE PRECISION by REAL to handle problem for promotion of real on IBM SP
!
!-------------------------------------------------------------------------------
!
!*       0.   DECLARATIONS
!             ------------
!
USE modd_surfex_omp, ONLY : nblock
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!-------------------------------------------------------------------------------
!
REAL, DIMENSION(:,:), ALLOCATABLE :: xworks
REAL, DIMENSION(:,:,:), ALLOCATABLE :: xwork2s
!
INTEGER, DIMENSION(:), ALLOCATABLE :: nreq
INTEGER, DIMENSION(:), ALLOCATABLE :: nindex
INTEGER, DIMENSION(:), ALLOCATABLE :: nnum
INTEGER, DIMENSION(:), ALLOCATABLE :: nindex_mnh
INTEGER, DIMENSION(:), ALLOCATABLE :: nnum_mnh
INTEGER, DIMENSION(:), ALLOCATABLE :: nsize_task
!
INTEGER :: ndim_full_init
!
INTEGER :: nproc = 1
INTEGER :: nrank = 0
INTEGER :: ncomm = -1
INTEGER :: npio  = 0
INTEGER :: nsize = 0
INTEGER :: myproc = 0
!
INTEGER :: idx_r = 0
INTEGER :: idx_w = 0
INTEGER :: idx_i = 0
!
REAL, DIMENSION(5) :: xtime_write
REAL, DIMENSION(6) :: xtime_calc
!
REAL :: xtime_npio_read=0
REAL :: xtime_npio_write=0
REAL :: xtime_comm_read=0
REAL :: xtime_calc_read=0
REAL :: xtime_comm_write=0
REAL :: xtime_calc_write=0
!
REAL :: xtime_init_sea=0
REAL :: xtime_init_water=0
REAL :: xtime_init_nature=0
REAL :: xtime_init_town=0
!
REAL :: xtime_sea=0
REAL :: xtime_water=0
REAL :: xtime_nature=0
REAL :: xtime_town=0
!
CONTAINS
!
SUBROUTINE wlog_mpi(HLOG,PLOG,KLOG,KLOG2,OLOG)
!
IMPLICIT NONE
!
 CHARACTER(LEN=*), INTENT(IN) :: HLOG
REAL, INTENT(IN),OPTIONAL :: PLOG
INTEGER, INTENT(IN), OPTIONAL :: KLOG
INTEGER, INTENT(IN), OPTIONAL :: KLOG2
LOGICAL, INTENT(IN), OPTIONAL :: OLOG
!
INTEGER :: IUNIT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODD_SURFEX_MPI:WLOG_MPI',0,zhook_handle)
!
iunit=100000+nrank
!
IF (PRESENT(olog)) THEN
  IF (PRESENT(plog)) THEN
    IF (PRESENT(klog)) THEN
      IF (PRESENT(klog2)) THEN
        WRITE(iunit,*) nblock, hlog, klog, klog2, plog, olog
      ELSE
        WRITE(iunit,*) nblock, hlog, klog, plog, olog
      ENDIF
    ELSE
      WRITE(iunit,*) nblock, hlog, plog, olog
    ENDIF
  ELSEIF (PRESENT(klog)) THEN
    IF (PRESENT(klog2)) THEN
      WRITE(iunit,*) nblock, hlog, klog, klog2, olog
    ELSE
      WRITE(iunit,*) nblock, hlog, klog, olog
    ENDIF
  ELSE
    WRITE(iunit,*) nblock, hlog, olog
  ENDIF
ELSEIF (PRESENT(plog)) THEN
  IF (PRESENT(klog)) THEN
    IF (PRESENT(klog2)) THEN
      WRITE(iunit,*) nblock, hlog, klog, klog2, plog
    ELSE
      WRITE(iunit,*) nblock, hlog, klog, plog
    ENDIF
  ELSE
    WRITE(iunit,*) nblock, hlog, plog
  ENDIF
ELSEIF (PRESENT(klog)) THEN
  IF (PRESENT(klog2)) THEN
    WRITE(iunit,*) nblock, hlog, klog, klog2
  ELSE
    WRITE(iunit,*) nblock, hlog, klog
  ENDIF
ELSE
  WRITE(iunit,*) nblock, hlog
ENDIF
!
IF (lhook) CALL dr_hook('MODD_SURFEX_MPI:WLOG_MPI',1,zhook_handle)
!
END SUBROUTINE wlog_mpi
!
SUBROUTINE prep_log_mpi
!
 CHARACTER(LEN=100) :: YNAME
 CHARACTER(LEN=10)  :: YRANK
INTEGER :: IUNIT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODD_SURFEX_MPI:PREP_LOG_MPI',0,zhook_handle)
!
WRITE(yrank,fmt='(I10)') nrank
yname='log'//adjustl(yrank)
!
iunit=100000+nrank
!
OPEN(unit=iunit,file=trim(yname),form='FORMATTED')
WRITE(iunit,*) "Log offline pour proc ",nrank
!
IF (lhook) CALL dr_hook('MODD_SURFEX_MPI:PREP_LOG_MPI',1,zhook_handle)
!
END SUBROUTINE prep_log_mpi
!
SUBROUTINE end_log_mpi
!
INTEGER :: IUNIT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODD_SURFEX_MPI:END_LOG_MPI',0,zhook_handle)
!
iunit=100000+nrank
!
WRITE(iunit,*) "End log offline pour proc ",nrank
CLOSE(UNIT=IUNIT)
!
IF (lhook) CALL dr_hook('MODD_SURFEX_MPI:END_LOG_MPI',1,zhook_handle)
!
END SUBROUTINE end_log_mpi
!-------------------------------------------------------------------------------
!
END MODULE modd_surfex_mpi