Juan 8/12/2016: add management of LEN_HREC in MNH & SURFEX
[MNH-git_open_source-lfs.git] / src / SURFEX / read_pgd_seaflux_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 READ_PGD_SEAFLUX_PAR_n(HPROGRAM,KSIZE,HDIR)
7 !     ################################################
8 !
9 !!****  *READ_PGD_SEAFLUX_PAR_n* - reads 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_SEAFLUX_GRID_n,   ONLY : NDIM
42 USE MODD_TYPE_DATE_SURF
43 USE MODD_DATA_SEAFLUX_n,   ONLY : NTIME, XDATA_SST, TDATA_SST
44 USE MODD_PREP,             ONLY : LINTERP
45 !
46 USE MODI_GET_LUOUT
47 USE MODI_READ_SURF
48 USE MODI_HOR_INTERPOL
49 !
50 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
51 USE PARKIND1  ,ONLY : JPRB
52 !
53 IMPLICIT NONE
54 !
55 !*       0.1   Declarations of arguments
56 !              -------------------------
57 !
58  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
59 INTEGER, INTENT(IN) :: KSIZE
60  CHARACTER(LEN=1),OPTIONAL,INTENT(IN)  :: HDIR       ! type of field :
61 !                                                   ! 'H' : field with
62 !                                                   !       horizontal spatial dim.
63 !                                                   ! '-' : no horizontal dim.
64 !
65 !*       0.2   Declarations of local variables
66 !              -------------------------------
67 !
68 REAL, DIMENSION(:,:), ALLOCATABLE :: ZDATA_SST
69  CHARACTER(LEN=LEN_HREC) :: YRECFM         ! Name of the article to be read
70  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
71  CHARACTER(LEN=1)  :: YDIR
72 INTEGER           :: ILUOUT
73 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
74 INTEGER           :: JTIME          ! loop index
75 INTEGER           :: IVERSION, IBUGFIX
76 REAL(KIND=JPRB) :: ZHOOK_HANDLE
77 !-------------------------------------------------------------------------------
78 !
79 IF (LHOOK) CALL DR_HOOK('READ_PGD_SEAFLUX_PAR_N',0,ZHOOK_HANDLE)
80 !
81  CALL GET_LUOUT(HPROGRAM,ILUOUT)
82 !
83 YDIR = 'H'
84 IF (PRESENT(HDIR)) YDIR = HDIR
85 !
86 YRECFM='VERSION'
87  CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
88 !
89 YRECFM='BUG'
90  CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
91 !
92 IF (IVERSION<4 .OR. IVERSION==4 .AND. IBUGFIX<=4 .OR. &
93     IVERSION>5 .OR. IVERSION==5 .AND. IBUGFIX>=1) THEN
94   YRECFM='ND_SEA_TIME'
95 ELSE
96   YRECFM='NDATA_SEA_TIME'
97 ENDIF
98  CALL READ_SURF(HPROGRAM,YRECFM,NTIME,IRESP,HCOMMENT=YCOMMENT)
99 !
100 ALLOCATE(ZDATA_SST (KSIZE,NTIME))
101 DO JTIME=1,NTIME
102   !
103   IF (IVERSION>5 .OR. IVERSION==5 .AND. IBUGFIX>=1) THEN
104     WRITE(YRECFM,FMT='(A7,I3.3)') 'D_SST_T',JTIME
105   ELSEIF (IVERSION<4 .OR. IVERSION==4 .AND. IBUGFIX<=4) THEN
106     WRITE(YRECFM,FMT='(A9,I3.3)') 'DATA_SST_',JTIME
107   ELSE
108     WRITE(YRECFM,FMT='(A10,I3.3)') 'DATA_SST_T',JTIME
109   ENDIF
110   !
111   CALL READ_SURF(HPROGRAM,YRECFM,ZDATA_SST(:,JTIME),IRESP,&
112                 HCOMMENT=YCOMMENT,HDIR=YDIR)
113   !
114 END DO
115 !
116 ALLOCATE(XDATA_SST(NDIM,NTIME))
117 IF (NDIM/=KSIZE) THEN
118   LINTERP(:) = .TRUE.      
119   DO JTIME=1,NTIME
120     CALL HOR_INTERPOL(ILUOUT,ZDATA_SST(:,JTIME:JTIME),XDATA_SST(:,JTIME:JTIME))
121   ENDDO
122   DEALLOCATE(ZDATA_SST)
123 ELSE
124   XDATA_SST(:,:) = ZDATA_SST(:,:)
125 ENDIF
126 !
127 ALLOCATE(TDATA_SST       (NTIME))
128 !
129 IF (IVERSION<4 .OR. IVERSION==4 .AND. IBUGFIX<=4) THEN
130   DO JTIME=1,NTIME
131     WRITE(YRECFM,FMT='(A7,I3.3)') 'DTA_SST',JTIME
132     YCOMMENT='(-)'
133     CALL READ_SURF(HPROGRAM,YRECFM,TDATA_SST,IRESP,HCOMMENT=YCOMMENT)
134   END DO
135 ELSE
136   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
137     YRECFM='TD_SST'
138   ELSE
139     YRECFM='TDATA_SST'
140   ENDIF
141   YCOMMENT='(-)'
142   CALL READ_SURF(HPROGRAM,YRECFM,TDATA_SST,IRESP,HCOMMENT=YCOMMENT)
143 ENDIF
144 !
145 IF (LHOOK) CALL DR_HOOK('READ_PGD_SEAFLUX_PAR_N',1,ZHOOK_HANDLE)
146 !-------------------------------------------------------------------------------
147 END SUBROUTINE READ_PGD_SEAFLUX_PAR_n