Philippe 07/03/2019: IO bugfix: io_set_mnhversion must be called by all the processes
[MNH-git_open_source-lfs.git] / src / SURFEX / writesurf_seafluxn.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 WRITESURF_SEAFLUX_n (HSELECT, O, OR, S, HPROGRAM)
7 !     ########################################
8 !
9 !!****  *WRITE_SEAFLUX_n* - writes SEAFLUX fields
10 !!
11 !!    PURPOSE
12 !!    -------
13 !!
14 !!**  METHOD
15 !!    ------
16 !!
17 !!    EXTERNAL
18 !!    --------
19 !!
20 !!
21 !!    IMPLICIT ARGUMENTS
22 !!    ------------------
23 !!
24 !!    REFERENCE
25 !!    ---------
26 !!
27 !!
28 !!    AUTHOR
29 !!    ------
30 !!      V. Masson   *Meteo France*      
31 !!
32 !!    MODIFICATIONS
33 !!    -------------
34 !!      Original    01/2003 
35 !!      Modified    01/2014 : S. Senesi : handle seaice scheme
36 !!      S. Belamari 03/2014   Include sea surface salinity XSSS
37 !!      R. Séférian 01/2015 : introduce interactive ocean surface albedo
38 !!      S. Senesi   08/2015 : fix units in some HCOMMENTs
39 !!      Modified    03/2014 : M.N. Bouin  ! possibility of wave parameters
40 !!                                        ! from external source
41 !!      Modified    11/2014 : J. Pianezze ! add currents and charnock coefficient
42 !-------------------------------------------------------------------------------
43 !
44 !*       0.    DECLARATIONS
45 !              ------------
46 !
47 !
48 USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
49 !
50 USE MODD_OCEAN_n, ONLY : OCEAN_t
51 USE MODD_OCEAN_REL_n, ONLY : OCEAN_REL_t
52 USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
53 !
54 USE MODD_SFX_OASIS,  ONLY : LCPL_WAVE, LCPL_SEA
55 !
56 USE MODI_WRITE_SURF
57 USE MODI_WRITESURF_OCEAN_n
58 USE MODI_WRITESURF_SEAICE_n
59 !
60 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
61 USE PARKIND1  ,ONLY : JPRB
62 !
63 IMPLICIT NONE
64 !
65 !*       0.1   Declarations of arguments
66 !              -------------------------
67 !
68  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT 
69 !
70 TYPE(OCEAN_t), INTENT(INOUT) :: O
71 TYPE(OCEAN_REL_t), INTENT(INOUT) :: OR
72 TYPE(SEAFLUX_t), INTENT(INOUT) :: S
73 !
74  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
75
76 !
77 !*       0.2   Declarations of local variables
78 !              -------------------------------
79 !
80 INTEGER           :: JMTH, INMTH
81  CHARACTER(LEN=2 ) :: YMTH
82 !
83 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
84  CHARACTER(LEN=LEN_HREC) :: YRECFM         ! Name of the article to be read
85  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
86 REAL(KIND=JPRB) :: ZHOOK_HANDLE
87 !
88 !-------------------------------------------------------------------------------
89 !
90 !
91 IF (LHOOK) CALL DR_HOOK('WRITESURF_SEAFLUX_N',0,ZHOOK_HANDLE)
92 !
93  CALL WRITESURF_OCEAN_n(HSELECT, O, OR, HPROGRAM)
94 !
95 !*       2.     Sea-ice prognostic fields:
96 !               --------------------------
97 !
98 !* flag to tell if Sea Ice model is used
99 !
100 YCOMMENT='flag to handle sea ice cover'
101  CALL WRITE_SURF(HSELECT, HPROGRAM,'HANDLE_SIC',S%LHANDLE_SIC,IRESP,YCOMMENT)
102 !
103 IF (S%LHANDLE_SIC) CALL WRITESURF_SEAICE_n(HSELECT, S, HPROGRAM)
104 !
105 !
106 !*       3.     Prognostic fields:
107 !               -----------------
108 !
109 !* water temperature
110 !
111 IF(S%LINTERPOL_SST)THEN
112 !
113   INMTH=SIZE(S%XSST_MTH,2)
114 !
115   DO JMTH=1,INMTH
116      WRITE(YMTH,'(I2)') (JMTH-1)
117      YRECFM='SST_MTH'//ADJUSTL(YMTH(:LEN_TRIM(YMTH)))
118      YCOMMENT='SST at month t'//ADJUSTL(YMTH(:LEN_TRIM(YMTH)))//' (K)'
119      CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,S%XSST_MTH(:,JMTH),IRESP,HCOMMENT=YCOMMENT)
120   ENDDO
121 !
122 ENDIF
123 !
124 YRECFM='SST'
125 YCOMMENT='SST (K)'
126  CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,S%XSST(:),IRESP,HCOMMENT=YCOMMENT)  
127 !
128 !-------------------------------------------------------------------------------
129 !
130 !*       4.     Semi-prognostic fields:
131 !               ----------------------
132 !
133 !* roughness length
134 !
135 YRECFM='Z0SEA'
136 YCOMMENT='Z0SEA (m)'
137  CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,S%XZ0(:),IRESP,HCOMMENT=YCOMMENT)
138  !
139 !* significant height
140 !
141 YRECFM='HS'
142 YCOMMENT='HS (m)'
143  CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,S%XHS(:),IRESP,HCOMMENT=YCOMMENT)
144 !
145 !* peak period
146 !
147 YRECFM='TP'
148 YCOMMENT='TP (s)'
149  CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,S%XTP(:),IRESP,HCOMMENT=YCOMMENT)
150 !
151 !
152 IF (LCPL_WAVE) THEN
153   !
154   !* Charnock coefficient
155   !
156   YRECFM='CHARN'
157   YCOMMENT='CHARN (-)'
158   CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,S%XCHARN(:),IRESP,HCOMMENT=YCOMMENT)
159   !
160 END IF
161 !
162 IF (LCPL_WAVE .OR. LCPL_SEA) THEN
163   !
164   !* u-current velocity
165   !
166   YRECFM='UMER'
167   YCOMMENT='UMER (m/s)'
168   CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,S%XUMER(:),IRESP,HCOMMENT=YCOMMENT)
169   !
170   !* v-current velocity
171   !
172   YRECFM='VMER'
173   YCOMMENT='VMER (m/s)'
174   CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,S%XVMER(:),IRESP,HCOMMENT=YCOMMENT)
175   !
176 ENDIF
177 !
178 !* sea surface salinity
179 !
180 IF(S%LINTERPOL_SSS)THEN
181    !
182    INMTH=SIZE(S%XSSS_MTH,2)
183    !
184    DO JMTH=1,INMTH
185       WRITE(YMTH,'(I2)') (JMTH-1)
186       YRECFM='SSS_MTH'//ADJUSTL(YMTH(:LEN_TRIM(YMTH)))
187       YCOMMENT='Sea Surface Salinity at month t'//ADJUSTL(YMTH(:LEN_TRIM(YMTH)))//' (psu)'
188       CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,S%XSSS_MTH(:,JMTH),IRESP,HCOMMENT=YCOMMENT)
189    ENDDO
190 !
191 ENDIF
192 !
193 YRECFM='SSS'
194 YCOMMENT='Sea Surface Salinity (psu)'
195  CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,S%XSSS(:),IRESP,HCOMMENT=YCOMMENT)  
196 !
197 !
198 !* ocean surface albedo (direct and diffuse fraction)
199 !
200 IF(S%CSEA_ALB=='RS14')THEN
201 !
202   YRECFM='OSA_DIR'
203   YCOMMENT='direct ocean surface albedo (-)'
204   CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,S%XDIR_ALB(:),IRESP,HCOMMENT=YCOMMENT)
205 !
206   YRECFM='OSA_SCA'
207   YCOMMENT='diffuse ocean surface albedo (-)'
208   CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,S%XSCA_ALB(:),IRESP,HCOMMENT=YCOMMENT)
209 !
210 ENDIF
211 !
212 !-------------------------------------------------------------------------------
213 !
214 !*       5.  Time
215 !            ----
216 !
217 YRECFM='DTCUR'
218 YCOMMENT='s'
219  CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,S%TTIME,IRESP,HCOMMENT=YCOMMENT)
220 !
221 IF (LHOOK) CALL DR_HOOK('WRITESURF_SEAFLUX_N',1,ZHOOK_HANDLE)
222 !
223 !
224 !-------------------------------------------------------------------------------
225 !
226 END SUBROUTINE WRITESURF_SEAFLUX_n