Juan 8/12/2016: add management of LEN_HREC in MNH & SURFEX
[MNH-git_open_source-lfs.git] / src / SURFEX / writesurf_pgd_seaf_parn.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_PGD_SEAF_PAR_n(HPROGRAM)
7 !     ################################################
8 !
9 !!****  *WRITESURF_PGD_SEAF_PAR_n* - writes SEAFLUX sst
10 !!                        
11 !!
12 !!    PURPOSE
13 !!    -------
14 !!
15 !!**  METHOD
16 !!    ------
17 !!
18 !!    EXTERNAL
19 !!    --------
20 !!
21 !!
22 !!    IMPLICIT ARGUMENTS
23 !!    ------------------
24 !!
25 !!    REFERENCE
26 !!    ---------
27 !!
28 !!
29 !!    AUTHOR
30 !!    ------
31 !!      P. Le Moigne   *Meteo France*   
32 !!
33 !!    MODIFICATIONS
34 !!    -------------
35 !!      Original    09/2007 
36 !-------------------------------------------------------------------------------
37 !
38 !*       0.    DECLARATIONS
39 !              ------------
40 !
41 USE MODD_TYPE_DATE_SURF
42 USE MODD_DATA_SEAFLUX_n,    ONLY : NTIME, XDATA_SST, TDATA_SST
43 !
44 USE MODI_WRITE_SURF
45 !
46 !
47 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
48 USE PARKIND1  ,ONLY : JPRB
49 !
50 IMPLICIT NONE
51 !
52 !*       0.1   Declarations of arguments
53 !              -------------------------
54 !
55  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
56 !
57 !*       0.2   Declarations of local variables
58 !              -------------------------------
59 !
60 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
61  CHARACTER(LEN=LEN_HREC) :: YRECFM         ! Name of the article to be read
62  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
63 INTEGER           :: JTIME          ! loop index
64 REAL(KIND=JPRB) :: ZHOOK_HANDLE
65 !
66 !
67 !-------------------------------------------------------------------------------
68 !
69 IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_SEAF_PAR_N',0,ZHOOK_HANDLE)
70 NTIME = SIZE(XDATA_SST,2)
71 YRECFM='ND_SEA_TIME'
72 YCOMMENT='(-)'
73  CALL WRITE_SURF(HPROGRAM,YRECFM,NTIME,IRESP,HCOMMENT=YCOMMENT)
74 !
75 DO JTIME=1,NTIME
76   WRITE(YRECFM,FMT='(A7,I3.3)') 'D_SST_T',JTIME
77   YCOMMENT='X_Y_DATA_SST'
78   CALL WRITE_SURF(HPROGRAM,YRECFM,XDATA_SST(:,JTIME),IRESP,HCOMMENT=YCOMMENT)
79 END DO
80 !
81 YRECFM='TD_SST'
82 YCOMMENT='(-)'
83  CALL WRITE_SURF(HPROGRAM,YRECFM,TDATA_SST,IRESP,HCOMMENT=YCOMMENT)
84 IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_SEAF_PAR_N',1,ZHOOK_HANDLE)
85 !
86 !-------------------------------------------------------------------------------
87 !
88 END SUBROUTINE WRITESURF_PGD_SEAF_PAR_n