58 USE yomhook
,ONLY : lhook, dr_hook
59 USE parkind1
,ONLY : jprb
71 TYPE(ocean_t),
INTENT(INOUT) :: o
74 CHARACTER(LEN=6),
INTENT(IN) :: hprogram
81 CHARACTER(LEN=12) :: yrecfm
82 CHARACTER(LEN=4 ) :: ylvl
83 CHARACTER(LEN=100):: ycomment
84 CHARACTER(LEN=14) :: yform
88 REAL,
DIMENSION(SIZE(O%XSEAT,1)) :: zwork
89 REAL(KIND=JPRB) :: zhook_handle
92 IF (lhook) CALL dr_hook(
'WRITESURF_OCEAN_N',0,zhook_handle)
97 ycomment=
'flag to use OCEAN model'
99 hprogram,yrecfm,o%LMERCATOR,iresp,hcomment=ycomment)
101 IF (.NOT. o%LMERCATOR .AND. lhook) CALL dr_hook(
'WRITESURF_OCEAN_N',1,zhook_handle)
102 IF (.NOT. o%LMERCATOR)
RETURN
106 ycomment=
'Number of OCEAN levels'
108 hprogram,yrecfm,nockmax,iresp,hcomment=ycomment)
110 DO jlevel=nockmin+1,nockmax
111 WRITE(ylvl,
'(I4)') jlevel
112 yrecfm=
'LEVL_OC'//adjustl(ylvl(:len_trim(ylvl)))
113 yform=
'(A21,I1.1,A4)'
114 IF (jlevel >= 10) yform=
'(A21,I2.2,A4)'
115 WRITE(ycomment,fmt=yform)
'Depth of OCEAN level ',jlevel,
' (m)'
117 hprogram,yrecfm,xzhoc(jlevel),iresp,hcomment=ycomment)
122 ycomment=
'Relaxation time of ocean model (s)'
124 hprogram,yrecfm,or%XTAU_REL,iresp,hcomment=ycomment)
127 ycomment=
'FLAG FOR RELAXATION ON CURRENT'
129 hprogram,yrecfm,or%LREL_CUR,iresp,hcomment=ycomment)
132 ycomment=
'FLAG FOR RELAXATION ON T,S'
134 hprogram,yrecfm,or%LREL_TS,iresp,hcomment=ycomment)
136 yrecfm=
'LFLX_NULL_OC'
137 ycomment=
'FLAG FOR ZERO FLUX '
139 hprogram,yrecfm,or%LFLUX_NULL,iresp,hcomment=ycomment)
141 yrecfm=
'LFLX_CORR_OC'
142 ycomment=
'FLAG FOR FLUX CORRECTION '
144 hprogram,yrecfm,or%LFLX_CORR,iresp,hcomment=ycomment)
147 ycomment=
'FLUX CORRECTION COEFF (W/M2/K)'
149 hprogram,yrecfm,or%XQCORR,iresp,hcomment=ycomment)
152 ycomment=
'FLAG FOR DIAPYCNAL MIXING '
154 hprogram,yrecfm,or%LDIAPYCNAL,iresp,hcomment=ycomment)
164 WRITE(ylvl,
'(I4)') jlevel
165 yrecfm=
'DTFNSOL'//adjustl(ylvl(:len_trim(ylvl)))
166 yform=
'(A11,I1.1,A5)'
167 IF (jlevel >= 10) yform=
'(A11,I2.2,A5)'
169 WRITE(ycomment,fmt=yform)
'X_Y_DTFNSOL',jlevel,
' (°C)'
172 hprogram,yrecfm,zwork,iresp,hcomment=ycomment)
176 DO jlevel=nockmin+1,nockmax
177 WRITE(ylvl,
'(I4)') jlevel
178 yrecfm=
'TEMP_OC'//adjustl(ylvl(:len_trim(ylvl)))
179 yform=
'(A11,I1.1,A5)'
180 IF (jlevel >= 10) yform=
'(A11,I2.2,A5)'
182 WRITE(ycomment,fmt=yform)
'X_Y_TEMP_OC',jlevel,
' (°C)'
183 zwork=o%XSEAT(:,jlevel)
185 hprogram,yrecfm,zwork,iresp,hcomment=ycomment)
189 DO jlevel=nockmin+1,nockmax
190 WRITE(ylvl,
'(I4)') jlevel
191 yrecfm=
'DTFSOL'//adjustl(ylvl(:len_trim(ylvl)))
192 yform=
'(A11,I1.1,A5)'
193 IF (jlevel >= 10) yform=
'(A11,I2.2,A5)'
195 WRITE(ycomment,fmt=yform)
'X_Y_DTFSOL',jlevel,
' (°C/s)'
196 zwork=o%XDTFSOL(:,jlevel)
198 hprogram,yrecfm,zwork,iresp,hcomment=ycomment)
203 DO jlevel=nockmin+1,nockmax
204 WRITE(ylvl,
'(I4)') jlevel
205 yrecfm=
'T_OC_REL'//adjustl(ylvl(:len_trim(ylvl)))
206 yform=
'(A11,I1.1,A5)'
207 IF (jlevel >= 10) yform=
'(A11,I2.2,A5)'
209 WRITE(ycomment,fmt=yform)
'X_Y_T_OC_REL',jlevel,
' (°C)'
210 zwork=or%XSEAT_REL(:,jlevel)
212 hprogram,yrecfm,zwork,iresp,hcomment=ycomment)
217 DO jlevel=nockmin+1,nockmax
218 WRITE(ylvl,
'(I4)') jlevel
219 yrecfm=
'SALT_OC'//adjustl(ylvl(:len_trim(ylvl)))
220 yform=
'(A11,I1.1,A5)'
221 IF (jlevel >= 10) yform=
'(A11,I2.2,A5)'
222 WRITE(ycomment,fmt=yform)
'X_Y_SALT_OC',jlevel,
'(psu)'
223 zwork=o%XSEAS(:,jlevel)
225 hprogram,yrecfm,zwork,iresp,hcomment=ycomment)
230 DO jlevel=nockmin+1,nockmax
231 WRITE(ylvl,
'(I4)') jlevel
232 yrecfm=
'S_OC_REL'//adjustl(ylvl(:len_trim(ylvl)))
233 yform=
'(A11,I1.1,A5)'
234 IF (jlevel >= 10) yform=
'(A11,I2.2,A5)'
235 WRITE(ycomment,fmt=yform)
'X_Y_S_OC_REL',jlevel,
'(psu)'
236 zwork=or%XSEAS_REL(:,jlevel)
238 hprogram,yrecfm,zwork,iresp,hcomment=ycomment)
243 DO jlevel=nockmin+1,nockmax
244 WRITE(ylvl,
'(I4)') jlevel
245 yrecfm=
'U_OC_REL'//adjustl(ylvl(:len_trim(ylvl)))
246 yform=
'(A11,I1.1,A5)'
247 IF (jlevel >= 10) yform=
'(A11,I2.2,A5)'
248 WRITE(ycomment,fmt=yform)
'X_Y_U_OC_REL',jlevel,
' M/S'
249 zwork=or%XSEAU_REL(:,jlevel)
251 hprogram,yrecfm,zwork,iresp,hcomment=ycomment)
254 DO jlevel=nockmin+1,nockmax
255 WRITE(ylvl,
'(I4)') jlevel
256 yrecfm=
'UCUR_OC'//adjustl(ylvl(:len_trim(ylvl)))
257 yform=
'(A11,I1.1,A5)'
258 IF (jlevel >= 10) yform=
'(A11,I2.2,A5)'
259 WRITE(ycomment,fmt=yform)
'X_Y_UCUR_OC',jlevel,
' (m/s)'
260 zwork=o%XSEAU(:,jlevel)
262 hprogram,yrecfm,zwork,iresp,hcomment=ycomment)
267 DO jlevel=nockmin+1,nockmax
268 WRITE(ylvl,
'(I4)') jlevel
269 yrecfm=
'V_OC_REL'//adjustl(ylvl(:len_trim(ylvl)))
270 yform=
'(A11,I1.1,A5)'
271 IF (jlevel >= 10) yform=
'(A11,I2.2,A5)'
272 WRITE(ycomment,fmt=yform)
'X_Y_V_OC_REL',jlevel,
' M/S'
273 zwork=or%XSEAV_REL(:,jlevel)
275 hprogram,yrecfm,zwork,iresp,hcomment=ycomment)
278 DO jlevel=nockmin+1,nockmax
279 WRITE(ylvl,
'(I4)') jlevel
280 yrecfm=
'VCUR_OC'//adjustl(ylvl(:len_trim(ylvl)))
281 yform=
'(A11,I1.1,A5)'
282 IF (jlevel >= 10) yform=
'(A11,I2.2,A5)'
283 WRITE(ycomment,fmt=yform)
'X_Y_VCUR_OC',jlevel,
'(m/s)'
284 zwork=o%XSEAV(:,jlevel)
286 hprogram,yrecfm,zwork,iresp,hcomment=ycomment)
291 DO jlevel=nockmin+1,nockmax
292 WRITE(ylvl,
'(I4)') jlevel
293 yrecfm=
'TKE_OC'//adjustl(ylvl(:len_trim(ylvl)))
294 yform=
'(A11,I1.1,A5)'
295 IF (jlevel >= 10) yform=
'(A11,I2.2,A5)'
296 WRITE(ycomment,fmt=yform)
'X_Y_TKE_OC',jlevel,
' (J)'
297 zwork=o%XSEAE(:,jlevel)
299 hprogram,yrecfm,zwork,iresp,hcomment=ycomment)
304 DO jlevel=nockmin+1,nockmax
305 WRITE(ylvl,
'(I4)') jlevel
306 yrecfm=
'KMEL_OC'//adjustl(ylvl(:len_trim(ylvl)))
307 yform=
'(A11,I1.1,A5)'
308 IF (jlevel >= 10) yform=
'(A11,I2.2,A5)'
309 WRITE(ycomment,fmt=yform)
'X_Y_KMEL_OC',jlevel,
' (m2/s2)'
310 zwork=o%XKMEL(:,jlevel)
312 hprogram,yrecfm,zwork,iresp,hcomment=ycomment)
322 DO jlevel=nockmin+1,nockmax
323 WRITE(ylvl,
'(I4)') jlevel
324 yrecfm=
'SEAINDBATH'//adjustl(ylvl(:len_trim(ylvl)))
325 yform=
'(A11,I1.1,A5)'
326 IF (jlevel >= 10) yform=
'(A11,I2.2,A5)'
327 WRITE(ycomment,fmt=yform)
'X_Y_SEAINDBATH',jlevel,
' (J)'
328 zwork=o%XSEABATH(:,jlevel)
330 hprogram,yrecfm,zwork,iresp,hcomment=ycomment)
339 hprogram,yrecfm,o%XSEAS(:,nockmin),iresp,hcomment=ycomment)
346 hprogram,yrecfm,o%XSEAHMO(:),iresp,hcomment=ycomment)
348 IF (lhook) CALL dr_hook(
'WRITESURF_OCEAN_N',1,zhook_handle)
subroutine writesurf_ocean_n(DGU, U, O, OR, HPROGRAM)