ol_read_atm_conf_ascii.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.
!     #########
SUBROUTINE ol_read_atm_conf_ascii (YSC, &
                                    hsurf_filetype, hforcing_filetype,  &
                                     pduration, ptstep_forc, kni, &
                                     kyear, kmonth, kday, ptime,  &
                                     plat, plon, pzs,             &
                                     pzref, puref                 )  
!
!==================================================================
!!****  *OL_READ_ATM_CONF* - Initialization routine
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      F. Habets   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2004
!!      Modified by P. Le Moigne (04/2005): cleaning and checking
!!      Modified by P. Le Moigne (04/2006): init_io_surf for nature
!!                  with GTMSK to read dimensions.
!==================================================================
!
!
!
USE modd_surfex_n, ONLY : surfex_t
!
!
USE modd_type_date_surf
!
USE modd_surfex_mpi, ONLY : nrank, npio, ncomm, nproc, xtime_comm_read, xtime_npio_read
!
USE modd_arch, ONLY : little_endian_arch
USE modd_io_surf_asc, ONLY : nni_forc
!
USE modi_get_luout
USE modi_init_io_surf_n
USE modi_read_surf
USE modi_end_io_surf_n
USE modi_get_size_full_n
USE modi_read_and_send_mpi
USE modi_abor1_sfx
!
USE modi_set_surfex_filein
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
#ifdef SFX_MPI
include 'mpif.h'
#endif
!
!
TYPE(surfex_t), INTENT(INOUT) :: ysc
!
 CHARACTER(LEN=6), INTENT(IN)  :: hsurf_filetype
 CHARACTER(LEN=6), INTENT(IN)  :: hforcing_filetype
INTEGER,          INTENT(OUT) :: kni
INTEGER,          INTENT(OUT) :: kyear, kmonth, kday
REAL,             INTENT(OUT) :: pduration,ptstep_forc
REAL,             INTENT(OUT) :: ptime
REAL, DIMENSION(:),  POINTER  :: plat, plon
REAL, DIMENSION(:),  POINTER  :: pzs 
REAL, DIMENSION(:),  POINTER  :: pzref, puref
!
REAL, DIMENSION(:), ALLOCATABLE :: zwork
REAL                          :: zwork0
REAL                          :: ztime
 CHARACTER(LEN=1)              :: yswap
TYPE (date_time)              :: ttime
INTEGER                       :: ini, idim_full
INTEGER                       :: iyear, imonth, iday
INTEGER                       :: iluout
INTEGER                       :: iret, inb_forc
INTEGER                       :: infompi
DOUBLE PRECISION   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
!==================================================================
!
IF (lhook) CALL dr_hook('OL_READ_ATM_CONF_ASCII',0,zhook_handle)
!
IF (nrank==npio) THEN
  !
  CALL get_luout(hsurf_filetype,iluout) 
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
  !*      1.    Define configuration parameters
  !
  yswap='N'
  IF (hforcing_filetype == 'BINARY') READ(21,*) yswap
  IF (yswap.EQ.'Y') THEN 
    little_endian_arch=.NOT.little_endian_arch
    WRITE(iluout,*) '*******************************************************************'
    WRITE(iluout,*) 'Architecture of the machine needs to swap LITTLE_ENDIAN_ARCH to ', &
                    little_endian_arch  
    WRITE(iluout,*) '*******************************************************************'
  ENDIF
  !
  READ(21,*) ini
  nni_forc = ini
  !
  READ(21,*) inb_forc
  READ(21,*) ptstep_forc
  pduration = ( inb_forc - 1 ) * ptstep_forc
  !
  READ(21,*) iyear
  READ(21,*) imonth
  READ(21,*) iday
  READ(21,*) ztime
  !
#ifdef SFX_MPI
  xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
  !
ENDIF
!
IF (nproc>1) THEN
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
  CALL mpi_bcast(ptstep_forc,kind(ptstep_forc)/4,mpi_real,npio,ncomm,infompi)
  CALL mpi_bcast(pduration,kind(pduration)/4,mpi_real,npio,ncomm,infompi)
  xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
#endif
ENDIF
!
!*      2.    Read full grid dimension and date
!
 CALL set_surfex_filein(hsurf_filetype,'PREP')
 CALL init_io_surf_n(ysc%DTCO, ysc%DGU, ysc%U, &
                     hsurf_filetype,'FULL  ','SURF  ','READ ') 
!
 CALL read_surf(&
                hsurf_filetype,'DIM_FULL',idim_full,iret)
 CALL read_surf(&
                hsurf_filetype,'DTCUR',ttime,iret)
!
 CALL end_io_surf_n(hsurf_filetype)
!
kyear  = ttime%TDATE%YEAR
kmonth = ttime%TDATE%MONTH
kday   = ttime%TDATE%DAY
ptime  = ttime%TIME
!
!*      4.    Geographical initialization
!
 CALL get_size_full_n(ysc%U, &
                      'OFFLIN ',idim_full,kni) 
!
ALLOCATE(plon(kni))
ALLOCATE(plat(kni))
ALLOCATE(pzs(kni))
ALLOCATE(pzref(kni))
ALLOCATE(puref(kni))
!
IF (nrank==npio) THEN
  ALLOCATE(zwork(idim_full))
ELSE
  ALLOCATE(zwork(0))
ENDIF
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
  IF (ini==1) THEN
    READ(unit=21,fmt='(F15.8)') zwork0
    zwork(:) = zwork0
  ELSE
    READ(unit=21,fmt='(50(F15.8))') zwork
  END IF
  !
#ifdef SFX_MPI
  xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
ENDIF
 CALL read_and_send_mpi(zwork,plon)
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
  IF (ini==1) THEN
    READ(unit=21,fmt='(F15.8)') zwork0
    zwork(:) = zwork0
  ELSE
    READ(unit=21,fmt='(50(F15.8))') zwork
  END IF
  !
#ifdef SFX_MPI
  xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
ENDIF
 CALL read_and_send_mpi(zwork,plat)
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
  IF (ini==1) THEN
    READ(unit=21,fmt='(F15.8)') zwork0
    zwork(:) = zwork0
  ELSE
    READ(unit=21,fmt='(50(F15.8))') zwork
  END IF
  !
#ifdef SFX_MPI
  xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
ENDIF
 CALL read_and_send_mpi(zwork,pzs)
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime() 
#endif
  !
  IF (ini==1) THEN
    READ(unit=21,fmt='(F15.8)') zwork0
    zwork(:) = zwork0
  ELSE
    READ(unit=21,fmt='(50(F15.8))') zwork
  END IF
  !
#ifdef SFX_MPI
  xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
ENDIF
 CALL read_and_send_mpi(zwork,pzref)
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
  IF (ini==1) THEN
    READ(unit=21,fmt='(F15.8)') zwork0
    zwork(:) = zwork0
  ELSE
    READ(unit=21,fmt='(50(F15.8))') zwork
  END IF
  !
#ifdef SFX_MPI
  xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
ENDIF
 CALL read_and_send_mpi(zwork,puref)
!
DEALLOCATE(zwork)
!
!*      3.    Check the consistency
!
IF (nrank==npio) THEN
  !
  IF (idim_full /= ini .AND. ini/=1) THEN
    WRITE(iluout,*)' NUMBER OF GRID POINTS INCONSISTENCY: ',kni,'/',ini
    CALL abor1_sfx('OL_READ_ATM_CONF_ASCII: NUMBER OF GRID POINTS INCONSISTENCY')
  ENDIF
  !
  !  check date and time
  !
  IF ( (kyear /= iyear) .OR. (kmonth /= imonth) .OR. (kday /= iday) ) THEN
    WRITE(iluout,*)' DATE INCONSISTANCY: ',kyear,kmonth,kday,'/',iyear,imonth,iday
    CALL abor1_sfx('OL_READ_ATM_CONF_ASCII: DATE INCONSISTENCY')
  ENDIF
  !
  IF ( ptime /= ztime ) THEN
    WRITE(iluout,*)' TIME INCONSISTANCY: ',ptime,'/',ztime
    CALL abor1_sfx('OL_READ_ATM_CONF_ASCII: TIME INCONSISTENCY')
  ENDIF
  !
ENDIF
!
IF (lhook) CALL dr_hook('OL_READ_ATM_CONF_ASCII',1,zhook_handle)
!
END SUBROUTINE ol_read_atm_conf_ascii