Philippe 07/03/2019: IO bugfix: io_set_mnhversion must be called by all the processes
[MNH-git_open_source-lfs.git] / src / SURFEX / read_watfluxn.F90
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
4 !SFX_LIC for details. version 1.
5 !     #########
6       SUBROUTINE READ_WATFLUX_n (DTCO, U, W, HPROGRAM)
7 !     #########################################
8 !
9 !!****  *READ_WATFLUX_n* - reads WATFLUX variables
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 !!      V. Masson   *Meteo France*
32 !!
33 !!    MODIFICATIONS
34 !!    -------------
35 !!      Original    01/2003 
36 !-------------------------------------------------------------------------------
37 !
38 !*       0.    DECLARATIONS
39 !              ------------
40 !
41 !
42 !
43 !
44 !
45 USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
46 USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
47 USE MODD_WATFLUX_n, ONLY : WATFLUX_t
48 !
49 USE MODI_READ_SURF
50 USE MODI_INTERPOL_TS_WATER_MTH
51 !
52 !
53 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
54 USE PARKIND1  ,ONLY : JPRB
55 !
56 USE MODI_GET_TYPE_DIM_n
57 !
58 IMPLICIT NONE
59 !
60 !*       0.1   Declarations of arguments
61 !              -------------------------
62 !
63 !
64 TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
65 TYPE(SURF_ATM_t), INTENT(INOUT) :: U
66 TYPE(WATFLUX_t), INTENT(INOUT) :: W
67 !
68  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! calling program
69 !
70 !
71 !*       0.2   Declarations of local variables
72 !              -------------------------------
73 !
74 INTEGER           :: JMTH, INMTH
75  CHARACTER(LEN=2 ) :: YMTH
76 !
77 INTEGER           :: ILU          ! 1D physical dimension
78 !
79 INTEGER           :: IRESP          ! Error code after redding
80 !
81  CHARACTER(LEN=LEN_HREC) :: YRECFM         ! Name of the article to be read
82 REAL(KIND=JPRB) :: ZHOOK_HANDLE
83 !
84 !-------------------------------------------------------------------------------
85 !
86 !* 1D physical dimension
87 !
88 IF (LHOOK) CALL DR_HOOK('READ_WATFLUX_N',0,ZHOOK_HANDLE)
89 YRECFM='SIZE_WATER'
90  CALL GET_TYPE_DIM_n(DTCO, U, 'WATER ',ILU)
91 !
92 !*       3.     Prognostic fields:
93 !               -----------------
94 !
95 !* water temperature
96 !
97 ALLOCATE(W%XTS(ILU))
98 !
99 IF(W%LINTERPOL_TS)THEN
100 !
101 !  Initialize current Month
102    W%TZTIME%TDATE%YEAR  = W%TTIME%TDATE%YEAR
103    W%TZTIME%TDATE%MONTH = W%TTIME%TDATE%MONTH
104    W%TZTIME%TDATE%DAY   = W%TTIME%TDATE%DAY
105    W%TZTIME%TIME        = W%TTIME%TIME
106
107 ! Precedent, Current, Next, and Second-next Monthly SST
108   INMTH=4
109 !
110   ALLOCATE(W%XTS_MTH(SIZE(W%XTS),INMTH))
111   DO JMTH=1,INMTH
112      WRITE(YMTH,'(I2)') (JMTH-1)
113      YRECFM='TS_WATER'//ADJUSTL(YMTH(:LEN_TRIM(YMTH)))
114      CALL READ_SURF(HPROGRAM,YRECFM,W%XTS_MTH(:,JMTH),IRESP)
115   ENDDO
116 !
117   CALL INTERPOL_TS_WATER_MTH(W)
118 !
119 ELSE
120
121   ALLOCATE(W%XTS_MTH(0,0))
122 !
123   YRECFM='TS_WATER'
124   CALL READ_SURF(HPROGRAM,YRECFM,W%XTS(:),IRESP)
125 !
126 ENDIF
127 !
128 !
129 !-------------------------------------------------------------------------------
130 !
131 !*       4.     Semi-prognostic fields:
132 !               ----------------------
133 !
134 !* roughness length
135 !
136 ALLOCATE(W%XZ0(ILU))
137 YRECFM='Z0WATER'
138 W%XZ0(:) = 0.001
139   CALL READ_SURF(HPROGRAM,YRECFM,W%XZ0(:),IRESP)
140 IF (LHOOK) CALL DR_HOOK('READ_WATFLUX_N',1,ZHOOK_HANDLE)
141 !
142 !-------------------------------------------------------------------------------
143
144 !
145 END SUBROUTINE READ_WATFLUX_n