Beginning of open source history
[MNH-git_open_source-lfs.git] / src / SURFEX / writesurf_dummyn.F90
1 !     #########
2       SUBROUTINE WRITESURF_DUMMY_n(HPROGRAM)
3 !     ##########################################
4 !
5 !!****  *WRITESURF_DUMMY_n* - routine to write dummy surface fields
6 !!
7 !!    PURPOSE
8 !!    -------
9 !!
10 !!    AUTHOR
11 !!    ------
12 !!      V. Masson   *Meteo France*      
13 !!
14 !!    MODIFICATIONS
15 !!    -------------
16 !!      Original    03/2004
17 !-------------------------------------------------------------------------------
18 !
19 !*       0.    DECLARATIONS
20 !              ------------
21 !
22 USE MODD_DUMMY_SURF_FIELDS_n, ONLY : NDUMMY_NBR,  CDUMMY_NAME,    &
23                                        CDUMMY_AREA, XDUMMY_FIELDS  
24 !
25 USE MODI_WRITE_SURF
26 !
27 !
28 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
29 USE PARKIND1  ,ONLY : JPRB
30 !
31 IMPLICIT NONE
32 !
33 !*       0.1   Declarations of arguments
34 !              -------------------------
35 !
36  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM     ! 
37 !
38 !*       0.2   Declarations of local variables
39 !              -------------------------------
40 !
41 INTEGER           :: JDUMMY         ! loop counter
42 !
43  CHARACTER(LEN=20 ):: YSTRING20      ! string
44  CHARACTER(LEN=3  ):: YSTRING03      ! string
45 !
46 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
47  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
48  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
49 REAL(KIND=JPRB) :: ZHOOK_HANDLE
50 !
51 !-------------------------------------------------------------------------------
52 !
53 !*       1.     Number of dummy fields :
54 !               ----------------------
55 !
56 IF (LHOOK) CALL DR_HOOK('WRITESURF_DUMMY_N',0,ZHOOK_HANDLE)
57 YRECFM='DUMMY_GR_NBR'
58 YCOMMENT=' '
59 !
60  CALL WRITE_SURF(HPROGRAM,YRECFM,NDUMMY_NBR,IRESP,HCOMMENT=YCOMMENT)
61 !
62 !-------------------------------------------------------------------------------
63 !
64 !*       2.     Dummy fields :
65 !               ------------
66 !
67 DO JDUMMY=1,NDUMMY_NBR
68   !
69   WRITE(YRECFM,'(A8,I3.3,A5)') 'DUMMY_GR',JDUMMY,'     '
70   YSTRING20=CDUMMY_NAME(JDUMMY)
71   YSTRING03=CDUMMY_AREA(JDUMMY)
72   YCOMMENT='X_Y_'//YRECFM//YSTRING20//YSTRING03//  &
73              '                                                             '  
74   CALL WRITE_SURF(HPROGRAM,YRECFM,XDUMMY_FIELDS(:,JDUMMY),IRESP,HCOMMENT=YCOMMENT)
75 END DO
76 IF (LHOOK) CALL DR_HOOK('WRITESURF_DUMMY_N',1,ZHOOK_HANDLE)
77 !
78 !-------------------------------------------------------------------------------
79 !
80 END SUBROUTINE WRITESURF_DUMMY_n