read_dummyn.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 read_dummy_n (&
                                duu, u, &
                               hprogram)
!     #################################
!
!!****  *READ_DUMMY_n* - routine to READ dummy surface fields
!!
!!    PURPOSE
!!    -------
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    03/2004
!!      P.Tulet     2015  Bug depassement de tableau YRECFM
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
!
!
!
!
USE modd_dummy_surf_fields_n, ONLY : dummy_surf_fields_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modi_read_surf
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
!
!
TYPE(dummy_surf_fields_t), INTENT(INOUT) :: duu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=6), INTENT(IN) :: hprogram     ! 
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER           :: jdummy         ! loop counter
!
 CHARACTER(LEN=20 ):: ystring20      ! string
 CHARACTER(LEN=3  ):: ystring03      ! string
!
INTEGER           :: iresp          ! IRESP  : return-code if a problem appears
 CHARACTER(LEN=12) :: yrecfm         ! Name of the article to be read
 CHARACTER(LEN=100):: ycomment       ! Comment string
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
!*       2.     Number of dummy fields :
!               ----------------------
!
IF (lhook) CALL dr_hook('READ_DUMMY_N',0,zhook_handle)
yrecfm='DUMMY_GR_NBR'
ycomment=' '
!
 CALL read_surf(&
                hprogram,yrecfm,duu%NDUMMY_NBR,iresp,hcomment=ycomment)
!
!-------------------------------------------------------------------------------
!
!*       3.     Dummy fields :
!               ------------
!
ALLOCATE(duu%CDUMMY_NAME(duu%NDUMMY_NBR))
ALLOCATE(duu%CDUMMY_AREA(duu%NDUMMY_NBR))
ALLOCATE(duu%XDUMMY_FIELDS(u%NSIZE_FULL,duu%NDUMMY_NBR))
duu%CDUMMY_NAME(:) = '                    '
duu%CDUMMY_AREA(:) = '   '
!
!
DO jdummy=1,duu%NDUMMY_NBR
  !
  WRITE(yrecfm,fmt='(A8,I3.3,A1)') 'DUMMY_GR',jdummy,'     '
  CALL read_surf(&
                hprogram,yrecfm,duu%XDUMMY_FIELDS(:,jdummy),iresp,hcomment=ycomment)
  !
  !
  ystring20=ycomment(21:40)
  ystring03=ycomment(41:43)
  !
  duu%CDUMMY_NAME(jdummy) = ystring20
  duu%CDUMMY_AREA(jdummy) = ystring03
  !
END DO
IF (lhook) CALL dr_hook('READ_DUMMY_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE read_dummy_n