src/SURFEX/read_dummyn.F90

   1 !SURFEX_LIC Copyright 1994-2014 Meteo-France
   2 !SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence
   3 !SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
   4 !SURFEX_LIC for details. version 1.
   5 !     #########
   6       SUBROUTINE READ_DUMMY_n(HPROGRAM)
   7 !     #################################
   8 !
   9 !!****  *READ_DUMMY_n* - routine to READ dummy surface fields
  10 !!
  11 !!    PURPOSE
  12 !!    -------
  13 !!
  14 !!    AUTHOR
  15 !!    ------
  16 !!      V. Masson   *Meteo France*
  17 !!
  18 !!    MODIFICATIONS
  19 !!    -------------
  20 !!      Original    03/2004
  21 !!      P.Tulet     2015  Bug depassement de tableau YRECFM
  22 !-------------------------------------------------------------------------------
  23 !
  24 !*       0.    DECLARATIONS
  25 !              ------------
  26 !
  27 USE MODD_DUMMY_SURF_FIELDS_n, ONLY : NDUMMY_NBR,  CDUMMY_NAME,    &
  28                                        CDUMMY_AREA, XDUMMY_FIELDS
  29 USE MODD_SURF_ATM_n         , ONLY : NSIZE_FULL
  30 !
  31 USE MODI_READ_SURF
  32 !
  33 !
  34 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
  35 USE PARKIND1  ,ONLY : JPRB
  36 !
  37 IMPLICIT NONE
  38 !
  39 !*       0.1   Declarations of arguments
  40 !              -------------------------
  41 !
  42  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM     !
  43 !
  44 !*       0.2   Declarations of local variables
  45 !              -------------------------------
  46 !
  47 INTEGER           :: JDUMMY         ! loop counter
  48 !
  49  CHARACTER(LEN=20 ):: YSTRING20      ! string
  50  CHARACTER(LEN=3  ):: YSTRING03      ! string
  51 !
  52 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
  53  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
  54  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
  55 REAL(KIND=JPRB) :: ZHOOK_HANDLE
  56 !
  57 !-------------------------------------------------------------------------------
  58 !
  59 !*       2.     Number of dummy fields :
  60 !               ----------------------
  61 !
  62 IF (LHOOK) CALL DR_HOOK('READ_DUMMY_N',0,ZHOOK_HANDLE)
  63 YRECFM='DUMMY_GR_NBR'
  64 YCOMMENT=' '
  65 !
  66  CALL READ_SURF(HPROGRAM,YRECFM,NDUMMY_NBR,IRESP,HCOMMENT=YCOMMENT)
  67 !
  68 CDUMMY_NAME(:) = '                    '
  69 CDUMMY_AREA(:) = '   '
  70
  71 !-------------------------------------------------------------------------------
  72 !
  73 !*       3.     Dummy fields :
  74 !               ------------
  75 !
  76 ALLOCATE(XDUMMY_FIELDS(NSIZE_FULL,NDUMMY_NBR))
  77 !
  78 !
  79 DO JDUMMY=1,NDUMMY_NBR
  80   !
  81   WRITE(YRECFM,FMT='(A8,I3.3,A1)') 'DUMMY_GR',JDUMMY,' '
  82   CALL READ_SURF(HPROGRAM,YRECFM,XDUMMY_FIELDS(:,JDUMMY),IRESP,HCOMMENT=YCOMMENT)
  83   !
  84   !
  85   YSTRING20=YCOMMENT(21:40)
  86   YSTRING03=YCOMMENT(41:43)
  87   !
  88   CDUMMY_NAME(JDUMMY) = YSTRING20
  89   CDUMMY_AREA(JDUMMY) = YSTRING03
  90   !
  91 END DO
  92 IF (LHOOK) CALL DR_HOOK('READ_DUMMY_N',1,ZHOOK_HANDLE)
  93 !
  94 !-------------------------------------------------------------------------------
  95 !
  96 END SUBROUTINE READ_DUMMY_n