5d24e91fbe0e5a9027ea2f1b7614f18c028c4ffd
[MNH-git_open_source-lfs.git] / 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