Juan 13/01/2014: add header SURFEX_LIC to all SURFEX files
[MNH-git_open_source-lfs.git] / src / SURFEX / writesurf_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 WRITESURF_DUMMY_n(HPROGRAM)
7 !     ##########################################
8 !
9 !!****  *WRITESURF_DUMMY_n* - routine to write 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 !-------------------------------------------------------------------------------
22 !
23 !*       0.    DECLARATIONS
24 !              ------------
25 !
26 USE MODD_DUMMY_SURF_FIELDS_n, ONLY : NDUMMY_NBR,  CDUMMY_NAME,    &
27                                        CDUMMY_AREA, XDUMMY_FIELDS  
28 !
29 USE MODI_WRITE_SURF
30 !
31 !
32 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
33 USE PARKIND1  ,ONLY : JPRB
34 !
35 IMPLICIT NONE
36 !
37 !*       0.1   Declarations of arguments
38 !              -------------------------
39 !
40  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM     ! 
41 !
42 !*       0.2   Declarations of local variables
43 !              -------------------------------
44 !
45 INTEGER           :: JDUMMY         ! loop counter
46 !
47  CHARACTER(LEN=20 ):: YSTRING20      ! string
48  CHARACTER(LEN=3  ):: YSTRING03      ! string
49 !
50 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
51  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
52  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
53 REAL(KIND=JPRB) :: ZHOOK_HANDLE
54 !
55 !-------------------------------------------------------------------------------
56 !
57 !*       1.     Number of dummy fields :
58 !               ----------------------
59 !
60 IF (LHOOK) CALL DR_HOOK('WRITESURF_DUMMY_N',0,ZHOOK_HANDLE)
61 YRECFM='DUMMY_GR_NBR'
62 YCOMMENT=' '
63 !
64  CALL WRITE_SURF(HPROGRAM,YRECFM,NDUMMY_NBR,IRESP,HCOMMENT=YCOMMENT)
65 !
66 !-------------------------------------------------------------------------------
67 !
68 !*       2.     Dummy fields :
69 !               ------------
70 !
71 DO JDUMMY=1,NDUMMY_NBR
72   !
73   WRITE(YRECFM,'(A8,I3.3,A5)') 'DUMMY_GR',JDUMMY,'     '
74   YSTRING20=CDUMMY_NAME(JDUMMY)
75   YSTRING03=CDUMMY_AREA(JDUMMY)
76   YCOMMENT='X_Y_'//YRECFM//YSTRING20//YSTRING03//  &
77              '                                                             '  
78   CALL WRITE_SURF(HPROGRAM,YRECFM,XDUMMY_FIELDS(:,JDUMMY),IRESP,HCOMMENT=YCOMMENT)
79 END DO
80 IF (LHOOK) CALL DR_HOOK('WRITESURF_DUMMY_N',1,ZHOOK_HANDLE)
81 !
82 !-------------------------------------------------------------------------------
83 !
84 END SUBROUTINE WRITESURF_DUMMY_n