New URL for NEMO forge! http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

diaregmean.F90 in NEMO/branches/UKMO/NEMO_4.0.4_CO9_shelf_climate/src/OCE/DIA – NEMO

Context Navigation

source: NEMO/branches/UKMO/NEMO_4.0.4_CO9_shelf_climate/src/OCE/DIA/diaregmean.F90 @ 15575

Last change on this file since 15575 was 15434, checked in by hadjt, 3 years ago

Region mean and NOOS cross-sections

Use rcp (Specific heat capacity) from nemo physical constant

File size: 67.9 KB

Line
1	MODULE diaregmean
2	!!======================================================================
3	!! * MODULE diaharm *
4	!! Timeseries of Regional Means
5	!!======================================================================
6	!! History : 3.6 ! 11/2016 (J Tinker) Original code
7	!!----------------------------------------------------------------------
8	USE oce ! ocean dynamics and tracers variables
9	USE dom_oce ! ocean space and time domain
10	USE in_out_manager ! I/O units
11	USE iom ! I/0 library
12	USE phycst ! physical constants
13	USE diapea ! PEA
14	USE zdfmxl ! MLD
15	USE sbc_oce
16	USE diaar5
17
18
19	#if defined key_fabm
20	USE trc
21	USE par_fabm
22	#endif
23
24	IMPLICIT NONE
25	PRIVATE
26
27	LOGICAL , PUBLIC :: ln_diaregmean ! region mean calculation
28	INTEGER , PUBLIC :: n_regions_output
29	PUBLIC dia_regmean_init ! routine called by nemogcm.F90
30	PUBLIC dia_regmean ! routine called by diawri.F90
31	PUBLIC dia_calctmb_region_mean ! routine called by diatmb.F90
32
33
34
35	LOGICAL :: ln_diaregmean_ascii ! region mean calculation ascii output
36	LOGICAL :: ln_diaregmean_bin ! region mean calculation binary output
37	LOGICAL :: ln_diaregmean_nc ! region mean calculation netcdf output
38	LOGICAL :: ln_diaregmean_diaar5 ! region mean calculation including AR5 SLR terms
39	LOGICAL :: ln_diaregmean_diasbc ! region mean calculation including Surface BC
40	LOGICAL :: ln_diaregmean_mld ! region mean calculation including kara mld terms
41	LOGICAL :: ln_diaregmean_pea ! region mean calculation including pea terms
42	INTEGER :: nn_diaregmean_nhourlymean ! region mean number of hours in mean (normally 1., <0 = instantanous (slower))
43	LOGICAL :: ln_diaregmean_areawgt ! Area weight region mean and region std
44	LOGICAL :: ln_diaregmean_verbose ! Region mean code verbose
45
46
47	LOGICAL :: ln_diaregmean_bgc ! region mean calculation including BGC terms
48
49
50
51	REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: tmp_region_mask_real ! tempory region_mask of reals
52	INTEGER, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: region_mask ! region_mask matrix
53	INTEGER :: nmasks ! Number of mask files in region_mask.nc file -
54	INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: nreg_mat ! Number of regions in each mask
55
56	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: tmp_field_mat !: temporary region_mask
57	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: tmp_field_HSVM_mat !: temporary region_mask
58	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: tmp_field_AR5_mat !: temporary region_mask
59	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: tmp_field_SBC_mat !: temporary region_mask
60	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: region_area_mat !: temporary region_mask
61	INTEGER :: tmp_field_cnt ! tmp_field_cnt integer
62	!!----------------------------------------------------------------------
63	!! NEMO/OPA 3.6 , NEMO Consortium (2014)
64	!! $Id$
65	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
66	!!----------------------------------------------------------------------
67	CONTAINS
68
69	SUBROUTINE dia_regmean_init
70	!!---------------------------------------------------------------------------
71	!! * ROUTINE dia_regmean_init *
72	!!
73	!! ** Purpose: Initialization of region mask namelist
74	!!
75	!! ** Method : Read namelist
76	!! History
77	!! 3.6 ! 11-16 (J Tinker) Routine to initialize dia_regmean
78	!!---------------------------------------------------------------------------
79	!!
80	INTEGER :: ios ! Local integer output status for namelist read
81	INTEGER :: inum ! temporary logical unit ! copied from DOM/domzgr.F90
82	INTEGER :: ierr ! error integer for IOM_get
83	INTEGER :: idmaskvar ! output of iom_varid
84	INTEGER :: maskno ! counter for number of masks
85	INTEGER :: jj,ji ! i and j index
86	INTEGER :: tmpint ! temporary integer
87	INTEGER :: nn_regions_output,check_regions_output
88	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: tmpregion !: temporary region_mask
89	INTEGER, DIMENSION(3) :: zdimsz ! number of elements in each of the 3 dimensions (i.e., lon, lat, no of masks, 297, 375, 4) for an array
90	INTEGER :: zndims ! number of dimensions in an array (i.e. 3, )
91
92	CHARACTER(len=128) :: stop_error_message
93	#if defined key_fabm
94	INTEGER :: js,jl,jn, tmp_dummy
95
96	CHARACTER (len=120) :: tmp_name,tmp_long_name, tmp_unit
97
98	INTEGER :: BGC_nlevs,nBGC_output, bgci
99	CHARACTER(len = 10), ALLOCATABLE, DIMENSION(:) :: BGC_stat_name(:),BGC_lev_name(:),BGC_output_var(:)
100	#endif
101
102
103	#if defined key_fabm
104	NAMELIST/nam_diaregmean/ ln_diaregmean,nn_regions_output,ln_diaregmean_verbose, ln_diaregmean_ascii,ln_diaregmean_bin,ln_diaregmean_nc,&
105	& ln_diaregmean_mld, ln_diaregmean_pea,ln_diaregmean_diaar5,ln_diaregmean_diasbc,ln_diaregmean_bgc,&
106	& nn_diaregmean_nhourlymean,ln_diaregmean_areawgt
107	#else
108	NAMELIST/nam_diaregmean/ ln_diaregmean,nn_regions_output,ln_diaregmean_verbose, ln_diaregmean_ascii,ln_diaregmean_bin,ln_diaregmean_nc,&
109	& ln_diaregmean_mld, ln_diaregmean_pea,ln_diaregmean_diaar5,ln_diaregmean_diasbc,&
110	& nn_diaregmean_nhourlymean,ln_diaregmean_areawgt
111	#endif
112
113
114	! read in Namelist.
115	!!----------------------------------------------------------------------
116	!
117	REWIND ( numnam_ref ) ! Read Namelist nam_diatmb in referdiatmbence namelist : TMB diagnostics
118	READ ( numnam_ref, nam_diaregmean, IOSTAT=ios, ERR= 901 )
119	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diaregmean in reference namelist' )
120
121	REWIND( numnam_cfg ) ! Namelist nam_diatmb in configuration namelist TMB diagnostics
122	READ ( numnam_cfg, nam_diaregmean, IOSTAT = ios, ERR = 902 )
123	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nam_diaregmean in configuration namelist' )
124	IF(lwm) WRITE ( numond, nam_diaregmean )
125
126	IF(lwp) THEN ! Control print
127	WRITE(numout,*)
128	WRITE(numout,*) 'dia_regmean_init : Output regional mean Diagnostics'
129	WRITE(numout,*) '~~~~~~~~~~~~'
130	WRITE(numout,*) 'Namelist nam_regmean : set regmeanoutputs '
131	WRITE(numout,*) 'Switch for regmean diagnostics (T) or not (F) ln_diaregmean = ', ln_diaregmean
132	WRITE(numout,*) 'Integer for regmean number of regions = nn_regions_output', nn_regions_output
133	WRITE(numout,*) 'Switch for regmean verbose = ln_diaregmean_verbose', ln_diaregmean_verbose
134	WRITE(numout,*) 'Switch for regmean ascii output (T) or not (F) ln_diaregmean_ascii = ', ln_diaregmean_ascii
135	WRITE(numout,*) 'Switch for regmean binary output (T) or not (F) ln_diaregmean_bin = ', ln_diaregmean_bin
136	WRITE(numout,*) 'Switch for regmean netcdf output (T) or not (F) ln_diaregmean_nc = ', ln_diaregmean_nc
137	WRITE(numout,*) 'Switch for regmean kara mld terms (T) or not (F) ln_diaregmean_mld = ', ln_diaregmean_mld
138	WRITE(numout,*) 'Switch for regmean PEA terms (T) or not (F) ln_diaregmean_pea = ', ln_diaregmean_pea
139	WRITE(numout,*) 'Switch for regmean AR5 SLR terms (T) or not (F) ln_diaregmean_diaar5 = ', ln_diaregmean_diaar5
140	WRITE(numout,*) 'Switch for regmean Surface forcing terms (T) or not (F) ln_diaregmean_diasbc = ', ln_diaregmean_diasbc
141	WRITE(numout,*) 'Switch for regmean BioGeoChemistry terms (T) or not (F) ln_diaregmean_bgc = ', ln_diaregmean_bgc
142	WRITE(numout,*) 'Switch for regmean area weighting mean, std and cnt (T) or not (F) ln_diaregmean_areawgt = ', ln_diaregmean_areawgt
143	WRITE(numout,*) 'Integer for regmean number of hours averaged before iom_put '
144	WRITE(numout,*) ' (<0 = instanteous, default = 1) nn_diaregmean_nhourlymean = ', nn_diaregmean_nhourlymean
145	ENDIF
146
147
148	ALLOCATE( tmp_field_mat(jpi,jpj,19), STAT= ierr ) !SS/NB/DT/ZA/VA T/S, SSH, MLD, PEA, PEAT, PEAS
149	IF( ierr /= 0 ) CALL ctl_stop( 'tmp_field_mat: failed to allocate tmp_field_mat array' )
150	tmp_field_mat(:,:,:) = 0.
151
152	ALLOCATE( tmp_field_HSVM_mat(jpi,jpj,4), STAT= ierr ) !SS/NB/DT/ZA/VA T/S, SSH, MLD, PEA, PEAT, PEAS
153	IF( ierr /= 0 ) CALL ctl_stop( 'tmp_field_mat: failed to allocate tmp_field_mat array' )
154	tmp_field_HSVM_mat(:,:,:) = 0.
155
156	IF(ln_diaregmean_diaar5) THEN
157	ALLOCATE( tmp_field_AR5_mat(jpi,jpj,4), STAT= ierr ) !SLR terms
158	IF( ierr /= 0 ) CALL ctl_stop( 'tmp_field_AR5_mat: failed to allocate tmp_field_AR5_mat array' )
159	tmp_field_AR5_mat(:,:,:) = 0.
160	ENDIF
161
162	IF(ln_diaregmean_diasbc) THEN
163	ALLOCATE( tmp_field_SBC_mat(jpi,jpj,9), STAT= ierr ) !SBC terms
164	IF( ierr /= 0 ) CALL ctl_stop( 'tmp_field_SBC_mat: failed to allocate tmp_field_SBC_mat array' )
165	tmp_field_SBC_mat(:,:,:) = 0.
166	ENDIF
167
168
169	ALLOCATE( region_area_mat(jpi,jpj), STAT= ierr ) !SS/NB/DT/ZA/VA T/S, SSH, MLD, PEA, PEAT, PEAS
170	IF( ierr /= 0 ) CALL ctl_stop( 'region_area_mat: failed to allocate tmp_field_mat array' )
171	region_area_mat(:,:) = 1.
172
173
174	if ( ln_diaregmean_areawgt ) THEN
175	region_area_mat(:,:) = e1t(:,:)*e2t(:,:)
176	ENDIF
177
178	tmp_field_cnt = 0
179
180
181	#if defined key_fabm
182	! as there are so many BGC variables, write out the necessary iodef.xml and field_def.xml entries into ocean.output
183
184	IF(ln_diaregmean_bgc) THEN
185	IF(lwp) THEN ! Control print
186
187	BGC_nlevs = 5
188	ALLOCATE( BGC_stat_name(6),BGC_lev_name(BGC_nlevs))
189	nBGC_output = 16
190	ALLOCATE( BGC_output_var(nBGC_output))
191
192	BGC_output_var(1) = 'N1_p'
193	BGC_output_var(2) = 'N3_n'
194	BGC_output_var(3) = 'N4_n'
195	BGC_output_var(4) = 'N5_s'
196	BGC_output_var(5) = 'O2_o'
197	BGC_output_var(6) = 'P1_Chl'
198	BGC_output_var(7) = 'P2_Chl'
199	BGC_output_var(8) = 'P3_Chl'
200	BGC_output_var(9) = 'P4_Chl'
201	BGC_output_var(10) = 'P1_c'
202	BGC_output_var(11) = 'P2_c'
203	BGC_output_var(12) = 'P3_c'
204	BGC_output_var(13) = 'P4_c'
205	BGC_output_var(14) = 'Z4_c'
206	BGC_output_var(15) = 'Z5_c'
207	BGC_output_var(16) = 'Z6_c'
208
209	BGC_stat_name(1) = '_ave'
210	BGC_stat_name(2) = '_tot'
211	BGC_stat_name(3) = '_var'
212	BGC_stat_name(4) = '_cnt'
213	BGC_stat_name(5) = '_reg_id'
214	BGC_stat_name(6) = '_mask_id'
215	BGC_lev_name(1) = 'top'
216	BGC_lev_name(2) = 'bot'
217	BGC_lev_name(3) = 'dif'
218	BGC_lev_name(4) = 'zav'
219	BGC_lev_name(5) = 'vol'
220
221
222	WRITE(numout,*) ''
223	WRITE(numout,*) 'diaregmean BGC field_def.xml entries'
224	WRITE(numout,*) ''
225
226
227	DO jn=1,jp_fabm ! State loop
228	DO js=1,6
229	DO jl=1,BGC_nlevs
230
231	tmp_name=TRIM( TRIM("reg_")//TRIM(BGC_lev_name(jl))//TRIM("_")//TRIM(ctrcnm(jn))// TRIM(BGC_stat_name(js)) )
232
233	tmp_long_name = TRIM(ctrcln(jn))
234	tmp_unit = TRIM(ctrcun(jn))
235
236	! Where using volume integrated values, change units...
237
238	IF ((jl .EQ. 5) .AND. (js .EQ. 2)) then
239	SELECT CASE (trim(tmp_unit))
240	CASE ('mg C/m^3') ; tmp_unit = 'Mg C (T C)' !'mg C/m^3'
241	CASE ('mg/m^3') ; tmp_unit = 'Mg (T)' !'mg/m^3'
242	CASE ('mmol C/m^3') ; tmp_unit = 'Mmol C' !'mmol C/m^3'
243	CASE ('mmol N/m^3') ; tmp_unit = 'Mmol N' !'mmol N/m^3'
244	CASE ('mmol O_2/m^3') ; tmp_unit = 'Mmol O' !'mmol O_2/m^3'
245	CASE ('mmol P/m^3') ; tmp_unit = 'Mmol P' !'mmol P/m^3'
246	CASE ('mmol Si/m^3') ; tmp_unit = 'Mmol S' !'mmol Si/m^3'
247	CASE ('umol/kg') ; tmp_unit = 'Mmol' !'umol/kg' = mmol/m^3
248	! CASE ('1/m') ; cycle
249	CASE DEFAULT
250	tmp_unit = TRIM(TRIM(tmp_unit)//TRIM('x 1e9 m^3'))
251	END SELECT
252	ENDIF
253
254	WRITE(numout,*) TRIM(TRIM('<field id="')//TRIM(tmp_name)//TRIM('" long_name="')// &
255	& TRIM(BGC_lev_name(jl))//TRIM('_')//TRIM(tmp_long_name)//TRIM(BGC_stat_name(js))// &
256	& TRIM('" unit="'//TRIM(tmp_unit) //'" />'))
257
258	END DO
259	END DO
260	END DO
261
262	WRITE(numout,*) ''
263	WRITE(numout,*) 'diaregmean BGC iodef.xml entries'
264	WRITE(numout,*) ''
265	DO js=1,6
266
267	DO jn=1,jp_fabm ! State loop
268
269	DO bgci=1,nBGC_output!
270	if (trim(ctrcnm(jn)) == TRIM(BGC_output_var(bgci))) CYCLE
271	ENDDO
272	DO jl=1,BGC_nlevs
273	! only print out area averages for ss, nb, diff, and depth averaged, and total values for volume integrated
274	IF ((jl .EQ. 5) .AND. (js .NE. 2)) CYCLE ! cycle if vol, and not tot.
275	IF ((jl .NE. 5) .AND. (js .NE. 1)) CYCLE ! cycle if other levels, and not ave.
276
277	tmp_name=TRIM(TRIM("reg_")//TRIM(BGC_lev_name(jl))//TRIM("_")//TRIM(ctrcnm(jn))// TRIM(BGC_stat_name(js)))
278	tmp_long_name = TRIM(ctrcln(jn))
279
280	WRITE(numout,*) TRIM(TRIM('<field field_ref="')//TRIM(tmp_name)//TRIM('"/>'))
281
282	END DO !level
283	END DO ! State loop
284	END DO !statistic
285	WRITE(numout,*) ''
286	DEALLOCATE( BGC_stat_name,BGC_lev_name)
287
288	ENDIF ! Control print
289
290	ENDIF !ln_diaregmean_bgc
291
292	#endif
293
294
295	IF (ln_diaregmean) THEN
296
297	! Open region mask for region means, and retrieve the size of the mask (number of levels)
298	CALL iom_open ( 'region_mask.nc', inum )
299	idmaskvar = iom_varid( inum, 'mask', kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE.)
300	nmasks = zdimsz(3)
301
302	! read in the region mask (which contains floating point numbers) into a temporary array of reals.
303	ALLOCATE( tmp_region_mask_real(jpi,jpj,nmasks), STAT= ierr )
304	IF( ierr /= 0 ) CALL ctl_stop( 'dia_regmean_init: failed to allocate tmp_region_mask_real array' )
305
306	! Use jpdom_unknown to read in a n-layer mask.
307	tmp_region_mask_real(:,:,:) = 0
308	CALL iom_get( inum, jpdom_unknown, 'mask', tmp_region_mask_real(1:nlci,1:nlcj,1:nmasks), &
309	& kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,nmasks /) )
310
311	CALL iom_close( inum )
312
313	!Convert the region mask of reals into one of integers.
314
315	ALLOCATE( region_mask(jpi,jpj,nmasks), STAT= ierr )
316	IF( ierr /= 0 ) CALL ctl_stop( 'dia_regmean_init: failed to allocate region_mask array' )
317	region_mask(:,:,:) = 0
318	region_mask = int(tmp_region_mask_real(:,:,:))
319	DEALLOCATE( tmp_region_mask_real)
320
321
322	ALLOCATE( nreg_mat(nmasks), STAT= ierr )
323	IF( ierr /= 0 ) CALL ctl_stop( 'dia_regmean_init: failed to allocate nreg_mat array' )
324
325	! work out the number of regions in each mask, asssuming land is 0, and the regions are consectively numbered,
326	! without missing any number, so the number of regions is the maximum number + 1 (for land). mpp_max across the
327	! processors to get the global maxima
328	check_regions_output = 0
329	DO maskno = 1,nmasks
330	tmpint = maxval(region_mask(:,:,maskno))
331	CALL mpp_max( 'diaregionmean', tmpint )
332	nreg_mat(maskno) = tmpint + 1
333	check_regions_output = check_regions_output + tmpint + 1
334	END DO
335
336
337
338	! can't use IOM call, as this iom isn't called yet... maybe move into step after iom_init?
339	n_regions_output = nn_regions_output
340	write (stop_error_message, "(A70,I3,A8,I3)") "dia_regmean_init: namelist:nam_diaregmean nn_regions_output should be ",check_regions_output," but is ",n_regions_output
341
342	IF (check_regions_output .NE. n_regions_output) THEN
343	CALL ctl_stop(trim(stop_error_message))
344	ENDIF
345
346
347
348
349	IF(lwp) THEN
350	! if writing out as binary and text, open the files.
351	IF ( ln_diaregmean_bin ) THEN
352	! Open binary for region means
353	!JT CALL ctl_opn( numdct_reg_bin ,'region_mean_timeseries.dat' , 'NEW', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, .TRUE. )
354	CALL ctl_opn( numdct_reg_bin ,'region_mean_timeseries.dat' , 'APPEND', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
355	ENDIF
356
357	IF ( ln_diaregmean_ascii ) THEN
358	! Open text files for region means
359	!JT CALL ctl_opn( numdct_reg_txt ,'region_mean_timeseries.txt' , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .TRUE. )
360	CALL ctl_opn( numdct_reg_txt ,'region_mean_timeseries.txt' , 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
361	ENDIF
362	ENDIF
363	ENDIF
364
365	END SUBROUTINE dia_regmean_init
366
367	SUBROUTINE dia_calctmb_region_mean( pinfield,pouttmb )
368	!!---------------------------------------------------------------------
369	!! * ROUTINE dia_calctmb_region_mean *
370	!!
371	!! ** Purpose : Find the Top, Bottom and Top minus Bottom fields of water Column
372	!! : and depth average, and volume and mass intergated values.
373
374	!!
375	!! ** Method :
376	!! use mbathy to find surface, mid and bottom of model levels
377	!!
378	!! History :
379	!! 3.6 ! 08-14 (E. O'Dea) Routine based on dia_wri_foam
380	!!----------------------------------------------------------------------
381	!! * Modules used
382
383	! Routine to map 3d field to top, middle, bottom
384	IMPLICIT NONE
385
386
387	! Routine arguments
388	REAL(wp), DIMENSION(jpi, jpj, jpk), INTENT(IN ) :: pinfield ! Input 3d field and mask
389	REAL(wp), DIMENSION(jpi, jpj, 6 ), INTENT( OUT) :: pouttmb ! Output top, bottom and surface minus bed, zav, vol int, mass int
390
391	! Local variables
392	INTEGER :: ji,jj,jk ! Dummy loop indices
393
394	! Local Real
395	REAL(wp) :: zmdi ! set masked values
396	! for depth int
397	REAL(wp) :: tmpnumer,tmpnumer_mass,tmpdenom ,z_av_val,vol_int_val
398
399	zmdi=1.e+20 !missing data indicator for masking
400
401	!zmdi=0 !missing data indicator for masking
402
403	! Calculate top
404	pouttmb(:,:,1) = pinfield(:,:,1)tmask(:,:,1) + zmdi(1.0-tmask(:,:,1))
405
406	! Calculate middle
407	!DO jj = 1,jpj
408	! DO ji = 1,jpi
409	! jk = max(1,mbathy(ji,jj)/2)
410	! pouttmb(ji,jj,2) = pinfield(ji,jj,jk)tmask(ji,jj,jk) + zmdi(1.0-tmask(ji,jj,jk))
411	! END DO
412	!END DO
413
414	! Calculate bottom, and top minus bottom
415	DO jj = 1,jpj
416	DO ji = 1,jpi
417	IF ( tmask(ji,jj,1) .EQ. 1) THEN ! if land
418
419	!jk = max(1,mbathy(ji,jj) - 1)
420
421
422	!ikbot = mbkt(ji,jj)
423	!z2d(ji,jj) = tsn(ji,jj,ikbot,jp_tem)
424	jk = mbkt(ji,jj)
425
426	pouttmb(ji,jj,2) = pinfield(ji,jj,jk)tmask(ji,jj,jk) + zmdi(1.0-tmask(ji,jj,jk))
427
428	pouttmb(ji,jj,3) = (pouttmb(ji,jj,1) - pouttmb(ji,jj,2))tmask(ji,jj,1) + zmdi(1.0-tmask(ji,jj,1))
429
430	!Depth and volume integral:
431	!---------------------------
432	!Vol int = Concentration * vol of grid box, summed over depth.
433	!Mass int = Concentration * vol of grid box * density of water, summed over depth.
434	!Depth Average = Vol int divided by * (vol of grid box summed over depth).
435
436	tmpnumer = 0.
437	tmpnumer_mass = 0.
438	tmpdenom = 0.
439	DO jk = 1,jpk
440	tmpnumer = tmpnumer + pinfield(ji,jj,jk)tmask(ji,jj,jk)e1t(ji,jj)e2t(ji,jj)e3t_n(ji,jj,jk)
441	tmpnumer_mass = tmpnumer_mass + pinfield(ji,jj,jk)tmask(ji,jj,jk)e1t(ji,jj)e2t(ji,jj)e3t_n(ji,jj,jk)*rhop(ji,jj,jk)
442	tmpdenom = tmpdenom + tmask(ji,jj,jk)e1t(ji,jj)e2t(ji,jj)*e3t_n(ji,jj,jk)
443	END DO
444	!z_av_val = tmpnumer/tmpdenom
445	!vol_int_val = tmpnumer
446	!mass_int_val = tmpnumer*density
447
448	pouttmb(ji,jj,4) = tmpnumer/tmpdenom ! depth averaged
449	pouttmb(ji,jj,5) = tmpnumer ! Vol integrated
450	pouttmb(ji,jj,6) = tmpnumer_mass ! Mass integrated (for heat and salt calcs)
451	ELSE
452	pouttmb(ji,jj,1) = zmdi
453	pouttmb(ji,jj,2) = zmdi
454	pouttmb(ji,jj,3) = zmdi
455	pouttmb(ji,jj,4) = zmdi
456	pouttmb(ji,jj,5) = zmdi
457	pouttmb(ji,jj,6) = zmdi
458	ENDIF
459	END DO
460	END DO
461
462	END SUBROUTINE dia_calctmb_region_mean
463
464
465	SUBROUTINE dia_regmean( kt )
466	!!----------------------------------------------------------------------
467	!! * ROUTINE dia_regmean *
468	!! ** Purpose : Produce regional mean diagnostics
469	!!
470	!! ** Method : calls dia_wri_region_mean to calculate and write the regional means for a number of variables,
471	!! (calling dia_calctmb_region_mean where necessary).
472	!!
473	!! Closes all text and binary files on last time step
474	!!
475	!!
476	!!
477	!!
478	!! History :
479	!! 3.6 ! 11-16 (J. Tinker)
480	!!
481	!!--------------------------------------------------------------------
482	REAL(wp), POINTER, DIMENSION(:,:,:) :: tmp1mat ! temporary array of 1's
483	REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmbT ! temporary T workspace
484	REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmbS ! temporary S workspace
485	REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmb1 ! temporary density workspace
486	REAL(wp) :: zmdi ! set masked values
487	INTEGER, INTENT( in ) :: kt ! ocean time-step index
488
489	REAL(wp) :: zdt ! temporary reals
490	INTEGER :: i_steps, ierr ! no of timesteps per hour, allocation error index
491	INTEGER :: maskno,jj,ji,jk,jm,nreg ! indices of mask, i and j, and number of regions
492
493
494	CHARACTER (len=120) :: tmp_name
495	CHARACTER (len=120), DIMENSION(19) :: name_dat_mat
496	CHARACTER (len=120), DIMENSION(4) :: name_AR5_mat
497	CHARACTER (len=120), DIMENSION(9) :: name_SBC_mat
498	CHARACTER (len=120), DIMENSION(4) :: name_HSCM_mat
499	INTEGER :: vi
500	LOGICAL :: do_reg_mean
501	REAL(wp), DIMENSION(19) :: output_mulitpler_dat_mat
502	REAL(wp), DIMENSION(4) :: output_mulitpler_AR5_mat
503	REAL(wp), DIMENSION(9) :: output_mulitpler_SBC_mat
504	REAL(wp), DIMENSION(4) :: output_mulitpler_HSVM_mat
505
506
507	#if defined key_fabm
508	INTEGER :: jn ,tmp_dummy ! set masked values
509	REAL(wp) :: tmp_val ! tmp value, to allow min and max value clamping (not implemented)
510	INTEGER :: jl
511	CHARACTER (len=60) :: tmp_name_bgc_top,tmp_name_bgc_bot,tmp_name_bgc_dif, tmp_name_bgc_zav, tmp_name_bgc_vol
512	CHARACTER (len=60) :: tmp_output_filename
513	REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmbBGC ! temporary BGC workspace
514
515	LOGICAL :: verbose
516	verbose = ln_diaregmean_verbose
517	tmp_val = 0
518	#endif
519	zmdi=1.e+20 !missing data indicator for maskin
520
521	IF (ln_diaregmean) THEN
522	! If regional mean calculations required by namelist
523	! -----------------
524	! identify hourly time steps (not used)
525	zdt = rdt
526	!JT Not sure what this is?? IF( nacc == 1 ) zdt = rdtmin
527
528
529	IF (nn_diaregmean_nhourlymean <= 0) THEN
530	! 22 mins with instanteous values, 13 mins with hourly mean
531	IF(lwp ) WRITE(numout,*) 'dia_wri_region_mean instantaneous values!!!'
532	i_steps = 1
533	IF(lwp ) WRITE(numout,*) 'dia_wri_region_mean instantaneous values!!!'
534	ELSE
535
536	IF( MOD( (nn_diaregmean_nhourlymean*3600),INT(zdt) ) == 0 ) THEN
537	i_steps = (3600*nn_diaregmean_nhourlymean)/INT(zdt)
538	ELSE
539	CALL ctl_stop('STOP', 'dia_regmean: timestep must give MOD(3600,rdt) = 0 otherwise no hourly values are possible')
540	ENDIF
541
542	ENDIF
543
544
545
546
547
548
549	! Every time step, add physical, SBC, PEA, MLD terms to create hourly sums.
550	! Every hour, then hourly sums are divided by the number of timesteps in the hour to make hourly means
551	! These hourly mean values are then used to caluclate the regional means, and output with IOM.
552	#if defined key_fabm
553	! BGC values are not averaged up over the hour, but are output as hourly instantaneous values.
554	#endif
555
556
557	!Extract 2d fields from 3d T and S with dia_calctmb_region_mean
558	!CALL wrk_alloc( jpi , jpj, 6 , zwtmbT )
559	!CALL wrk_alloc( jpi , jpj, 6 , zwtmbS )
560	!CALL wrk_alloc( jpi , jpj, 6 , zwtmb1 )
561
562
563	ALLOCATE (zwtmbT(jpi , jpj, 6), STAT= ierr )
564	IF( ierr /= 0 ) CALL ctl_stop( 'dia_regmean: failed to allocate zwtmbT array' )
565	ALLOCATE (zwtmbS(jpi , jpj, 6), STAT= ierr )
566	IF( ierr /= 0 ) CALL ctl_stop( 'dia_regmean: failed to allocate zwtmbS array' )
567	ALLOCATE (zwtmb1(jpi , jpj, 6), STAT= ierr )
568	IF( ierr /= 0 ) CALL ctl_stop( 'dia_regmean: failed to allocate zwtmb1 array' )
569
570
571	CALL dia_calctmb_region_mean( tsn(:,:,:,jp_tem),zwtmbT)
572	CALL dia_calctmb_region_mean( tsn(:,:,:,jp_sal),zwtmbS)
573
574	! To calc regional mean time series of int vol and mass, run region mean code on array of 1's...
575	! - then when multplying by volume, gives volume,
576	! - then when multplying by volume*density, gives mass
577
578	ALLOCATE (tmp1mat(jpi , jpj, jpk), STAT= ierr )
579	IF( ierr /= 0 ) CALL ctl_stop( 'dia_regmean: failed to allocate tmp1mat array' )
580	DO jj = 1,jpj
581	DO ji = 1,jpi
582	DO jk = 1,jpk
583	tmp1mat(ji,jj,jk) = 1
584	END DO
585	END DO
586	END DO
587
588	CALL dia_calctmb_region_mean( tmp1mat,zwtmb1)
589	!JT CALL wrk_dealloc( jpi , jpj, jpk , tmp1mat )
590	DEALLOCATE( tmp1mat )
591
592	!tmp_field_HSVM_mat(:,:,1) = (zwtmbT(:,:,6)tmask(:,:,1)3850.) !heat 3850/4200 is value for FW, 3850 is the value for sea
593	tmp_field_HSVM_mat(:,:,1) = (zwtmbT(:,:,6)tmask(:,:,1)rcp) !heat 4200 is value for FW, 3850 is the value for sea water.
594	tmp_field_HSVM_mat(:,:,2) = (zwtmbS(:,:,6)*tmask(:,:,1)) !salt
595	tmp_field_HSVM_mat(:,:,3) = (zwtmb1(:,:,5)*tmask(:,:,1)) !vol
596	tmp_field_HSVM_mat(:,:,4) = (zwtmb1(:,:,6)*tmask(:,:,1)) !mass
597
598	name_HSCM_mat(1) = 'heat'
599	name_HSCM_mat(2) = 'salt'
600	name_HSCM_mat(3) = 'vol'
601	name_HSCM_mat(4) = 'mass'
602
603	output_mulitpler_HSVM_mat(:) = 1
604	output_mulitpler_HSVM_mat(1) = 1e-12
605	output_mulitpler_HSVM_mat(2) = 1e-12
606
607
608
609	! Add 2d fields every time step to the hourly total.
610
611	tmp_field_mat(:,:,1) = tmp_field_mat(:,:,1) + (zwtmbT(:,:,1)*tmask(:,:,1)) !sst
612	name_dat_mat(1) = 'sst'
613	tmp_field_mat(:,:,2) = tmp_field_mat(:,:,2) + (zwtmbT(:,:,2)*tmask(:,:,1)) !nbt
614	name_dat_mat(2) = 'nbt'
615	tmp_field_mat(:,:,3) = tmp_field_mat(:,:,3) + (zwtmbT(:,:,3)*tmask(:,:,1)) !dft
616	name_dat_mat(3) = 'dft'
617
618	tmp_field_mat(:,:,4) = tmp_field_mat(:,:,4) + (zwtmbT(:,:,4)*tmask(:,:,1)) !zat
619	name_dat_mat(4) = 'zat'
620	tmp_field_mat(:,:,5) = tmp_field_mat(:,:,5) + (zwtmbT(:,:,5)*tmask(:,:,1)) !vat
621	name_dat_mat(5) = 'vat'
622	tmp_field_mat(:,:,6) = tmp_field_mat(:,:,6) + (tmp_field_HSVM_mat(:,:,1))! heat
623	name_dat_mat(6) = 'heat'
624
625	tmp_field_mat(:,:,7) = tmp_field_mat(:,:,7) + (zwtmbS(:,:,1)*tmask(:,:,1)) !sss
626	name_dat_mat(7) = 'sss'
627	tmp_field_mat(:,:,8) = tmp_field_mat(:,:,8) + (zwtmbS(:,:,2)*tmask(:,:,1)) !nbs
628	name_dat_mat(8) = 'nbs'
629	tmp_field_mat(:,:,9) = tmp_field_mat(:,:,9) + (zwtmbS(:,:,3)*tmask(:,:,1)) !dfs
630	name_dat_mat(9) = 'dfs'
631
632	tmp_field_mat(:,:,10) = tmp_field_mat(:,:,10) + (zwtmbS(:,:,4)*tmask(:,:,1)) !zas
633	name_dat_mat(10) = 'zas'
634	tmp_field_mat(:,:,11) = tmp_field_mat(:,:,11) + (zwtmbS(:,:,5)*tmask(:,:,1)) !vas
635	name_dat_mat(11) = 'vas'
636	tmp_field_mat(:,:,12) = tmp_field_mat(:,:,12) + (tmp_field_HSVM_mat(:,:,2)) !salt
637	name_dat_mat(12) = 'salt'
638
639	tmp_field_mat(:,:,13) = tmp_field_mat(:,:,13) + (tmp_field_HSVM_mat(:,:,3))!vol
640	name_dat_mat(13) = 'vol'
641	tmp_field_mat(:,:,14) = tmp_field_mat(:,:,14) + (tmp_field_HSVM_mat(:,:,4))!mass
642	name_dat_mat(14) = 'mass'
643
644	tmp_field_mat(:,:,15) = tmp_field_mat(:,:,15) + (sshn(:,:)*tmask(:,:,1)) !ssh
645	name_dat_mat(15) = 'ssh'
646
647
648	DEALLOCATE (zwtmbT, zwtmbS, zwtmb1 )
649
650
651	IF( ln_diaregmean_mld ) THEN
652	IF( ALLOCATED( hmld_zint ) ) THEN
653	tmp_field_mat(:,:,16) = tmp_field_mat(:,:,16) + (hmld_zint(:,:)*tmask(:,:,1)) !mldkara
654	ENDIF
655	ENDIF
656
657	name_dat_mat(16) = 'mld'
658
659	IF( ln_diaregmean_pea ) THEN
660	tmp_field_mat(:,:,17) = tmp_field_mat(:,:,17) + (pea(:,:)*tmask(:,:,1)) !pea
661	tmp_field_mat(:,:,18) = tmp_field_mat(:,:,18) + (peat(:,:)*tmask(:,:,1)) !peat
662	tmp_field_mat(:,:,19) = tmp_field_mat(:,:,19) + (peas(:,:)*tmask(:,:,1)) !peas
663	ENDIF
664	name_dat_mat(17) = 'pea'
665	name_dat_mat(18) = 'peat'
666	name_dat_mat(19) = 'peas'
667
668	IF( ln_diaregmean_diaar5 ) THEN
669	tmp_field_AR5_mat(:,:,1) = tmp_field_AR5_mat(:,:,1) + (sshsteric_mat(:,:)*tmask(:,:,1))
670	name_AR5_mat(1) = 'ssh_steric'
671	tmp_field_AR5_mat(:,:,2) = tmp_field_AR5_mat(:,:,2) + (sshthster_mat(:,:)*tmask(:,:,1))
672	name_AR5_mat(2) = 'ssh_thermosteric'
673	tmp_field_AR5_mat(:,:,3) = tmp_field_AR5_mat(:,:,3) + (sshhlster_mat(:,:)*tmask(:,:,1))
674	name_AR5_mat(3) = 'ssh_halosteric'
675	tmp_field_AR5_mat(:,:,4) = tmp_field_AR5_mat(:,:,4) + (zbotpres_mat(:,:)*tmask(:,:,1))
676	name_AR5_mat(4) = 'bot_pres'
677	ENDIF
678
679
680	IF( ln_diaregmean_diasbc ) THEN
681	tmp_field_SBC_mat(:,:,1) = tmp_field_SBC_mat(:,:,1) + ((qsr + qns)*tmask(:,:,1))
682	name_SBC_mat(1) = 'qt'
683	tmp_field_SBC_mat(:,:,2) = tmp_field_SBC_mat(:,:,2) + (qsr*tmask(:,:,1))
684	name_SBC_mat(2) = 'qsr'
685	tmp_field_SBC_mat(:,:,3) = tmp_field_SBC_mat(:,:,3) + (qns*tmask(:,:,1))
686	name_SBC_mat(3) = 'qns'
687	tmp_field_SBC_mat(:,:,4) = tmp_field_SBC_mat(:,:,4) + (emp*tmask(:,:,1))
688	name_SBC_mat(4) = 'emp'
689	tmp_field_SBC_mat(:,:,5) = tmp_field_SBC_mat(:,:,5) + (wndm*tmask(:,:,1))
690	name_SBC_mat(5) = 'wspd'
691	tmp_field_SBC_mat(:,:,6) = tmp_field_SBC_mat(:,:,6) + (pressnow*tmask(:,:,1))
692	name_SBC_mat(6) = 'mslp'
693	tmp_field_SBC_mat(:,:,7) = tmp_field_SBC_mat(:,:,7) + (rnf*tmask(:,:,1))
694	name_SBC_mat(7) = 'rnf'
695
696	!tmp_field_SBC_mat(:,:,8) = tmp_field_SBC_mat(:,:,8) + (emptmask(:,:,1)tsn(:,:,1,jp_tem)*3850.)
697	tmp_field_SBC_mat(:,:,8) = tmp_field_SBC_mat(:,:,8) + (emptmask(:,:,1)tsn(:,:,1,jp_tem)*rcp)
698	name_SBC_mat(8) = 'empheat'
699	!tmp_field_SBC_mat(:,:,9) = tmp_field_SBC_mat(:,:,9) + (rnftmask(:,:,1)tsn(:,:,1,jp_tem)*3850.)
700	tmp_field_SBC_mat(:,:,9) = tmp_field_SBC_mat(:,:,9) + (rnftmask(:,:,1)tsn(:,:,1,jp_tem)*rcp)
701	name_SBC_mat(9) = 'rnfheat'
702
703	ENDIF
704
705	output_mulitpler_dat_mat(:) = 1.
706	output_mulitpler_dat_mat(6) = output_mulitpler_HSVM_mat(1) ! 1e-12
707	output_mulitpler_dat_mat(12) = output_mulitpler_HSVM_mat(2) ! 1e-12
708	output_mulitpler_AR5_mat(:) = 1.
709	output_mulitpler_SBC_mat(:) = 1.
710
711	! On the hour, calculate hourly means from the hourly total,and process the regional means.
712
713	tmp_field_cnt = tmp_field_cnt + 1
714
715
716	IF ( MOD( kt, i_steps ) == 0 .and. kt .ne. nn_it000 ) THEN
717
718
719	DO vi=1,19 ! State loop
720
721	do_reg_mean = .TRUE.
722
723	IF (vi == 16) THEN
724	IF( .not. ln_diaregmean_mld ) do_reg_mean = .FALSE.
725	ENDIF
726
727	IF ((vi == 17) .OR. (vi == 18) .OR. (vi == 19) ) THEN
728	IF( .not. ln_diaregmean_pea ) do_reg_mean = .FALSE.
729	ENDIF
730
731	tmp_name=TRIM( name_dat_mat(vi) )
732	IF ( do_reg_mean ) THEN
733	IF (iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_ave')))) .OR. &
734	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_tot')))) .OR. &
735	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_totheat')))) .OR. &
736	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_var')))) .OR. &
737	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_cnt')))) .OR. &
738	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_reg_id')))) .OR. &
739	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_mask_id')))) ) THEN
740
741	CALL dia_wri_region_mean(kt, TRIM(tmp_name) , output_mulitpler_dat_mat(vi)*tmp_field_mat(:,:,vi)/real(tmp_field_cnt,wp))
742	!WRITE(numout,*) 'JT dia_regmean SBC variable - region mean: ',TRIM( name_dat_mat(vi) ),';'
743	!ELSE
744	!WRITE(numout,*) 'JT dia_regmean SBC variable - no iom_use: ',TRIM( name_dat_mat(vi) ),';'
745	ENDIF
746	!ELSE
747	!WRITE(numout,*) 'JT dia_regmean SBC variable - no do_reg_mean: ',TRIM( name_dat_mat(vi) ),';',ln_diaregmean_mld,ln_diaregmean_pea
748	ENDIF
749	tmp_name=""
750	END DO
751
752	tmp_field_mat(:,:,:) = 0.
753
754	DO vi=1,4 ! State loop
755
756	tmp_name=TRIM( name_HSCM_mat(vi) ) // trim('_inst')
757	IF (iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_ave')))) .OR. &
758	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_tot')))) .OR. &
759	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_totarea')))) .OR. &
760	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_var')))) .OR. &
761	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_cnt')))) .OR. &
762	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_reg_id')))) .OR. &
763	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_mask_id')))) ) THEN
764
765	CALL dia_wri_region_mean(kt, TRIM(tmp_name) , output_mulitpler_HSVM_mat(vi)*tmp_field_HSVM_mat(:,:,vi))
766	ENDIF
767	tmp_name=""
768	END DO
769
770	tmp_field_HSVM_mat(:,:,:) = 0.
771	IF( ln_diaregmean_diaar5 ) THEN
772	DO vi=1,4 ! State loop
773
774	tmp_name=TRIM( name_AR5_mat(vi) )
775	IF (iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_ave')))) .OR. &
776	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_tot')))) .OR. &
777	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_totarea')))) .OR. &
778	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_var')))) .OR. &
779	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_cnt')))) .OR. &
780	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_reg_id')))) .OR. &
781	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_mask_id')))) ) THEN
782
783	CALL dia_wri_region_mean(kt, TRIM(tmp_name) , output_mulitpler_AR5_mat(vi)*tmp_field_AR5_mat(:,:,vi)/real(tmp_field_cnt,wp))
784	ENDIF
785	tmp_name=""
786	END DO
787	tmp_field_AR5_mat(:,:,:) = 0.
788	ENDIF
789
790	IF( ln_diaregmean_diasbc ) THEN
791	DO vi=1,9 ! State loop
792
793	tmp_name=TRIM( name_SBC_mat(vi) )
794	IF (iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_ave')))) .OR. &
795	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_tot')))) .OR. &
796	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_totarea')))) .OR. &
797	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_var')))) .OR. &
798	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_cnt')))) .OR. &
799	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_reg_id')))) .OR. &
800	& iom_use(trim( trim(trim("reg_") // trim(tmp_name) // trim('_mask_id')))) ) THEN
801
802	CALL dia_wri_region_mean(kt, TRIM(tmp_name) , output_mulitpler_SBC_mat(vi)*tmp_field_SBC_mat(:,:,vi)/real(tmp_field_cnt,wp))
803	ENDIF
804	tmp_name=""
805	END DO
806	tmp_field_SBC_mat(:,:,:) = 0.
807	ENDIF
808
809
810	#if defined key_fabm
811	!ADD Biogeochemistry
812
813	IF( ln_diaregmean_bgc ) THEN !ln_diaregmean_bgc
814
815	! Loop through 3d BGC tracers
816	DO jn=1,jp_fabm ! State loop
817
818	! get variable name for different levels
819	tmp_name_bgc_top=TRIM(TRIM("top_")//TRIM(ctrcnm(jn)))
820	tmp_name_bgc_bot=TRIM(TRIM("bot_")//TRIM(ctrcnm(jn)))
821	tmp_name_bgc_dif=TRIM(TRIM("dif_")//TRIM(ctrcnm(jn)))
822	tmp_name_bgc_zav=TRIM(TRIM("zav_")//TRIM(ctrcnm(jn)))
823	tmp_name_bgc_vol=TRIM(TRIM("vol_")//TRIM(ctrcnm(jn)))
824
825	! print out names if verbose
826	IF(verbose .AND. lwp) THEN
827	WRITE(numout,*)
828	WRITE(numout,*) 'dia_regmean tmp_name_bgc_top : ',TRIM(tmp_name_bgc_top)
829	WRITE(numout,*) 'dia_regmean tmp_name_bgc_bot : ',TRIM(tmp_name_bgc_bot)
830	WRITE(numout,*) 'dia_regmean tmp_name_bgc_dif : ',TRIM(tmp_name_bgc_dif)
831	WRITE(numout,*) 'dia_regmean tmp_name_bgc_zav : ',TRIM(tmp_name_bgc_zav)
832	WRITE(numout,*) 'dia_regmean tmp_name_bgc_vol : ',TRIM(tmp_name_bgc_vol)
833	CALL FLUSH(numout)
834
835	ENDIF
836
837	!Allocate working array, and get surface, bed etc fields.
838	!CALL wrk_alloc( jpi , jpj, 6 , zwtmbBGC )
839	ALLOCATE (zwtmbBGC(jpi , jpj, 6), STAT= ierr )
840	IF( ierr /= 0 ) CALL ctl_stop( 'dia_regmean: failed to allocate zwtmbBGC array' )
841	CALL dia_calctmb_region_mean( trn(:,:,:,jn),zwtmbBGC )
842
843
844	!Print out 2d fields to ascii text files to check values if verbose. (24MB per time step, per BGC variable)
845	IF (verbose) THEN
846
847	WRITE (tmp_output_filename, "(A4,I3.3,A1,I6.6,A1,I3.3,A4)") "bgc_",jn,"_",kt,"_",narea,".txt"
848	WRITE (,) tmp_output_filename
849	OPEN(UNIT=74,FILE=TRIM(tmp_output_filename))
850
851	DO ji = 1,jpi
852	DO jj = 1,jpj
853	WRITE(74,FMT="(I4,I4,F3,F25.5,F25.5,F25.5,F25.5,F25.5)") nimpp+ji, njmpp+jj,tmask(ji,jj,1),&
854	& zwtmbBGC(ji,jj,1),zwtmbBGC(ji,jj,2),zwtmbBGC(ji,jj,3),zwtmbBGC(ji,jj,4),zwtmbBGC(ji,jj,5)/1e9
855	END DO
856	END DO
857	CLOSE(74)
858	ENDIF
859
860	! Do region means
861	CALL dia_wri_region_mean(kt, TRIM(tmp_name_bgc_top) , zwtmbBGC(:,:,1))
862	CALL dia_wri_region_mean(kt, TRIM(tmp_name_bgc_bot) , zwtmbBGC(:,:,2))
863	CALL dia_wri_region_mean(kt, TRIM(tmp_name_bgc_dif) , zwtmbBGC(:,:,3))
864	CALL dia_wri_region_mean(kt, TRIM(tmp_name_bgc_zav) , zwtmbBGC(:,:,4))
865	CALL dia_wri_region_mean(kt, TRIM(tmp_name_bgc_vol) , zwtmbBGC(:,:,5)/1e9)
866
867
868	!Deallocate working array
869	!JT CALL wrk_dealloc( jpi , jpj, 6 , zwtmbBGC )
870	DEALLOCATE ( zwtmbBGC )
871	ENDDO ! State loop
872	ENDIF !ln_diaregmean_bgc
873
874	#endif
875
876	tmp_field_cnt = 0
877
878	ENDIF ! ( MOD( kt, i_steps ) == 0 .and. kt .ne. nn_it000 )
879
880
881	! If on the last time step, close binary and ascii files.
882	IF( kt == nitend ) THEN
883	IF(lwp) THEN
884	IF ( ln_diaregmean_bin ) THEN
885	!Closing binary files for regional mean time series.
886	CLOSE(numdct_reg_bin)
887	ENDIF
888	IF ( ln_diaregmean_ascii ) THEN
889	!Closing text files for regional mean time series.
890	CLOSE(numdct_reg_txt)
891	ENDIF
892
893	DEALLOCATE( region_mask, nreg_mat, tmp_field_mat,tmp_field_HSVM_mat)
894	IF( ln_diaregmean_diaar5 ) DEALLOCATE( tmp_field_AR5_mat)
895	IF( ln_diaregmean_diasbc ) DEALLOCATE( tmp_field_SBC_mat)
896	ENDIF
897	ENDIF
898
899
900	ELSE
901	CALL ctl_warn('dia_regmean: regmean diagnostic is set to false you should not have seen this')
902	ENDIF
903
904	END SUBROUTINE dia_regmean
905
906
907	SUBROUTINE dia_wri_region_mean(kt, tmp_name, infield )
908	!!---------------------------------------------------------------------
909	!! * ROUTINE dia_tmb *
910	!!
911	!! ** Purpose : Calculate and write region mean time series for 2d arrays
912	!!
913	!! ** Method :
914	!! use
915	!!
916	!! History :
917	!! ?? ! 15/10/2015 (JTinker) Routine taken from old dia_wri_foam
918	!!----------------------------------------------------------------------
919	!! * Modules used
920	!use lib_mpp
921	!use lib_fortr
922	IMPLICIT NONE
923
924	INTEGER, INTENT(in) :: kt
925	CHARACTER (len=*) , INTENT(IN ) :: tmp_name
926	REAL(wp), DIMENSION(jpi, jpj), INTENT(IN ) :: infield ! Input 3d field and mask
927
928	! Local variables
929	INTEGER, DIMENSION(jpi, jpj) :: internal_region_mask ! Input 3d field and mask
930	REAL(wp), DIMENSION(jpi, jpj) :: internal_infield ! Internal data field
931	REAL(wp), ALLOCATABLE, DIMENSION(:) :: zrmet_ave,zrmet_tot,zrmet_totarea,zrmet_var,zrmet_cnt,zrmet_mask_id,zrmet_reg_id ,zrmet_min,zrmet_max
932	REAL(wp), ALLOCATABLE, DIMENSION(:) :: zrmet_out
933	REAL(wp), ALLOCATABLE, DIMENSION(:) :: ave_mat,tot_mat,num_mat,var_mat,ssq_mat,cnt_mat,reg_id_mat,mask_id_mat,area_mat,totarea_mat !: region_mask
934	!REAL(wp), ALLOCATABLE, DIMENSION(:) :: min_mat,max_mat !: region_mask
935
936	REAL(wp) :: zmdi, zrmet_val ! set masked values
937	INTEGER :: maskno,nreg ! ocean time-step indexocean time step
938	INTEGER :: ji,jj,jk,ind,jm ! Dummy loop indices
939	INTEGER :: reg_ind_cnt ! Dummy loop indices
940
941	INTEGER :: ierr
942	REAL(wp) :: tmpreal
943	CHARACTER(LEN=180) :: FormatString,nreg_string,tmp_name_iom
944	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: dummy_zrmet
945	LOGICAL :: verbose
946
947
948	verbose = ln_diaregmean_verbose
949
950
951	zmdi=1.e+20 !missing data indicator for maskin
952
953	!Allocate output arrays for iomput, set to zmdi, and set a region counter = 1
954	ALLOCATE( zrmet_ave(n_regions_output), STAT= ierr )
955	IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_ave array' )
956	ALLOCATE( zrmet_tot(n_regions_output), STAT= ierr )
957	IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_tot array' )
958	ALLOCATE( zrmet_totarea(n_regions_output), STAT= ierr )
959	IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_totarea array' )
960	ALLOCATE( zrmet_var(n_regions_output), STAT= ierr )
961	IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_var array' )
962	ALLOCATE( zrmet_cnt(n_regions_output), STAT= ierr )
963	IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_cnt array' )
964	ALLOCATE( zrmet_mask_id(n_regions_output), STAT= ierr )
965	IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_mask_id array' )
966	ALLOCATE( zrmet_reg_id(n_regions_output), STAT= ierr )
967	IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_reg_id array' )
968
969
970	ALLOCATE( zrmet_min(n_regions_output), STAT= ierr )
971	IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_min array' )
972	ALLOCATE( zrmet_max(n_regions_output), STAT= ierr )
973	IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_max array' )
974
975	ALLOCATE( zrmet_out(n_regions_output), STAT= ierr )
976	IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_reg_id array' )
977
978
979
980	IF(lwp .AND. verbose) THEN
981	WRITE(numout,*)
982	WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//';'
983	WRITE(numout,*)
984	ENDIF
985
986	DO ji = 1,jpi
987	DO jj = 1,jpj
988	internal_infield(ji,jj) = infield(ji,jj)
989	END DO
990	END DO
991
992	! Check for NANS # JT 03/09/2018
993	DO ji = 1,jpi
994	DO jj = 1,jpj
995	IF ( tmask(ji,jj,1) == 1.0_wp ) THEN
996	IF ( internal_infield(ji,jj) .ne. internal_infield(ji,jj) ) THEN
997	WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//' Nan at (kt,i,j): ',kt,nimpp+ji, njmpp+jj !ji - (-jpizoom+1-nimpp+1),jj - (-jpjzoom+1-njmpp+1)
998	internal_infield(ji,jj) = 0.
999	ENDIF
1000	ELSE
1001	IF ( internal_infield(ji,jj) .ne. internal_infield(ji,jj) ) THEN
1002	WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//' Masked Nan at (kt,i,j): ',kt,nimpp+ji, njmpp+jj !,ji - (-jpizoom+1-nimpp+1),jj - (-jpjzoom+1-njmpp+1)
1003	internal_infield(ji,jj) = 0.
1004	ENDIF
1005	ENDIF
1006	END DO
1007	END DO
1008
1009
1010	zrmet_ave(:) = zmdi
1011	zrmet_tot(:) = zmdi
1012	zrmet_totarea(:) = zmdi
1013	zrmet_var(:) = zmdi
1014	zrmet_cnt(:) = zmdi
1015	zrmet_mask_id(:) = zmdi
1016	zrmet_reg_id(:) = zmdi
1017
1018	zrmet_min(:) = zmdi
1019	zrmet_max(:) = zmdi
1020	reg_ind_cnt = 1
1021
1022
1023	! loop though the masks
1024	DO maskno = 1,nmasks
1025	IF(lwp .AND. verbose) WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//'; begin mask loops: ',maskno
1026
1027
1028	! For each mask, get the number of regions (nreg), and a local copy of the region.
1029	nreg = nreg_mat(maskno)
1030	internal_region_mask = region_mask(:,:,maskno)
1031
1032	! allocate temporary stat arrays, and set to zero
1033	ALLOCATE( ave_mat(nreg), STAT= ierr )
1034	IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate ave_mat array' )
1035	ALLOCATE( tot_mat(nreg), STAT= ierr )
1036	IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate tot_mat array' )
1037	ALLOCATE( num_mat(nreg), STAT= ierr )
1038	IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate num_mat array' )
1039	ALLOCATE( var_mat(nreg), STAT= ierr )
1040	IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate var_mat array' )
1041	ALLOCATE( ssq_mat(nreg), STAT= ierr )
1042	IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate ssq_mat array' )
1043	ALLOCATE( cnt_mat(nreg), STAT= ierr )
1044	IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate cnt_mat array' )
1045	ALLOCATE( area_mat(nreg), STAT= ierr )
1046	IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate area_mat array' )
1047	ALLOCATE( totarea_mat(nreg), STAT= ierr )
1048	IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate totarea_mat array' )
1049
1050	!ALLOCATE( min_mat(nreg), STAT= ierr )
1051	!IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate min_mat array' )
1052	!ALLOCATE( max_mat(nreg), STAT= ierr )
1053	!IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate max_mat array' )
1054
1055	ALLOCATE( reg_id_mat(nreg), STAT= ierr )
1056	IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate reg_id_mat array' )
1057	ALLOCATE( mask_id_mat(nreg), STAT= ierr )
1058	IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate mask_id_mat array' )
1059
1060
1061
1062	ave_mat(:) = 0.
1063	tot_mat(:) = 0.
1064	num_mat(:) = 0.
1065	var_mat(:) = 0.
1066	cnt_mat(:) = 0.
1067	ssq_mat(:) = 0.
1068	area_mat(:) = 0.
1069	totarea_mat(:) = 0.
1070
1071
1072	!min_mat(:) = zmdi
1073	!max_mat(:) = -zmdi
1074	reg_id_mat(:) = 0.
1075	mask_id_mat(:) = 0.
1076
1077	! loop though the array. for each sea grid box where tmask == 1),
1078	! read which region the grid box is in, add the value of the gridbox (and its square)
1079	! to the total for that region, and then increment the counter for that region.
1080	!CALL cpu_time(start_reg_mean_loop)
1081	!WRITE(numout,*) kt,start_reg_mean_loop
1082	IF(lwp .AND. verbose) WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//'; begin spatial loops: '
1083	DO ji = nldi,nlei
1084	DO jj = nldj,nlej
1085	IF ( tmask(ji,jj,1) == 1.0_wp ) THEN
1086	ind = internal_region_mask(ji,jj)+1
1087	!tot_mat(ind) = tot_mat(ind) + (internal_infield(ji,jj))
1088	!ssq_mat(ind) = ssq_mat(ind) + ( internal_infield(ji,jj) * internal_infield(ji,jj))
1089	!cnt_mat(ind) = cnt_mat(ind) + 1.
1090	! Area Weighted values - region_area_mat == 1. or area depending on ln_diaregmean_areawgt
1091	totarea_mat(ind) = totarea_mat(ind) + (region_area_mat(ji,jj)*internal_infield(ji,jj))
1092	tot_mat(ind) = tot_mat(ind) + (internal_infield(ji,jj))
1093	ssq_mat(ind) = ssq_mat(ind) + (region_area_mat(ji,jj)(internal_infield(ji,jj) internal_infield(ji,jj)))
1094	cnt_mat(ind) = cnt_mat(ind) + 1.
1095	area_mat(ind) = area_mat(ind) + (region_area_mat(ji,jj)*1.)
1096
1097
1098
1099	!min_mat(ind) = min(min_mat(ind),internal_infield(ji,jj))
1100	!max_mat(ind) = max(max_mat(ind),internal_infield(ji,jj))
1101	ENDIF
1102	END DO
1103	END DO
1104	IF(lwp .AND. verbose) WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//'; finish spatial loops: '
1105	! sum the totals, the counts, and the squares across the processors
1106	CALL mpp_sum( 'diaregionmean',tot_mat,nreg )
1107	IF(lwp .AND. verbose) WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//'; finished mpp_sum tot'
1108	CALL mpp_sum( 'diaregionmean',cnt_mat,nreg )
1109	IF(lwp .AND. verbose) WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//'; finished mpp_sum cnt'
1110	CALL mpp_sum( 'diaregionmean',area_mat,nreg )
1111	IF(lwp .AND. verbose) WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//'; finished mpp_sum area'
1112	CALL mpp_sum( 'diaregionmean',totarea_mat,nreg )
1113	IF(lwp .AND. verbose) WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//'; finished mpp_sum totarea_mat'
1114
1115
1116
1117	!tmp_name_iom = trim(trim("reg_") // trim(tmp_name) // trim('_var'))
1118	!IF (iom_use(trim(tmp_name_iom)) .OR. ln_diaregmean_bin .OR. ln_diaregmean_ascii) THEN
1119	CALL mpp_sum( 'diaregionmean',ssq_mat,nreg )
1120	IF(lwp .AND. verbose) WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//'; finished mpp_sum ssq'
1121	!ENDIF
1122
1123
1124
1125	!tmp_name_iom = trim(trim("reg_") // trim(tmp_name) // trim('_min'))
1126	!IF (iom_use(trim(tmp_name_iom)) .OR. ln_diaregmean_bin .OR. ln_diaregmean_ascii) THEN
1127	!CALL mpp_min( 'diaregionmean',min_mat,nreg )
1128	!IF(lwp .AND. verbose) WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//'; finished mpp_min'
1129	!ENDIF
1130
1131
1132	!tmp_name_iom = trim(trim("reg_") // trim(tmp_name) // trim('_max'))
1133	!IF (iom_use(trim(tmp_name_iom)) .OR. ln_diaregmean_bin .OR. ln_diaregmean_ascii) THEN
1134	!CALL mpp_max( 'diaregionmean',max_mat,nreg )
1135	!IF(lwp .AND. verbose) WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//'; finished mpp_max'
1136	!ENDIF
1137
1138	! calculate the mean and variance from the total, sum of squares and the count.
1139	! When area weighting, you can't area weight the total.
1140	! this if block may be redundant, as totarea_mat == tot_mat, and cnt_mat == area_mat when ln_diaregmean_areawgt == False
1141	IF (ln_diaregmean_areawgt) THEN
1142	ave_mat = totarea_mat(:)/area_mat(:)
1143	var_mat = ssq_mat(:)/area_mat(:) - (ave_mat(:)*ave_mat(:))
1144	ELSE
1145	ave_mat = tot_mat(:)/cnt_mat(:)
1146	var_mat = ssq_mat(:)/cnt_mat(:) - (ave_mat(:)*ave_mat(:))
1147	ENDIF
1148
1149
1150
1151	!mask array of mask and region number.
1152	DO jj = 1,nreg
1153	reg_id_mat(jj) = real(jj-1)
1154	mask_id_mat(jj) = real(maskno)
1155	END DO
1156
1157
1158	!write text and binary, and note region statistics for current mask for later iom_put
1159	IF( lwp ) THEN
1160
1161	!Write out ascii and binary if requred
1162	IF ( ln_diaregmean_bin ) THEN
1163	!Writing out regional mean time series to binary files
1164	WRITE(numdct_reg_bin) tmp_name,kt,maskno,n_regions_output
1165	WRITE(numdct_reg_bin) ave_mat
1166	WRITE(numdct_reg_bin) tot_mat
1167	WRITE(numdct_reg_bin) var_mat
1168	WRITE(numdct_reg_bin) ssq_mat
1169	WRITE(numdct_reg_bin) cnt_mat
1170	!WRITE(numdct_reg_bin) min_mat
1171	!WRITE(numdct_reg_bin) max_mat
1172	ENDIF
1173
1174	IF ( ln_diaregmean_ascii ) THEN
1175	!Writing out regional mean time series to text files
1176
1177	WRITE(nreg_string, "(I5)") nreg
1178	FormatString = "(A30,"//trim(nreg_string)//"F25.3)"
1179	WRITE(numdct_reg_txt, FMT="(A30,I6,I6)") tmp_name,kt,maskno
1180	WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(tmp_name)//" "//"ave_mat:", ave_mat
1181	WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(tmp_name)//" "//"tot_mat:", tot_mat
1182	WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(tmp_name)//" "//"var_mat:", var_mat
1183	WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(tmp_name)//" "//"ssq_mat:", ssq_mat
1184	WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(tmp_name)//" "//"cnt_mat:", cnt_mat
1185	!WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(tmp_name)//" "//"min_mat:", min_mat
1186	!WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(tmp_name)//" "//"max_mat:", max_mat
1187	WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(tmp_name)//" "//"reg_mat:", reg_id_mat
1188	WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(tmp_name)//" "//"msk_mat:", mask_id_mat
1189
1190	ENDIF
1191	ENDIF
1192
1193	! JT Fixed, was not meant to be inside the lwp if block
1194	DO jm = 1,nreg
1195	zrmet_ave( reg_ind_cnt) = ave_mat(jm)
1196	zrmet_tot( reg_ind_cnt) = tot_mat(jm)
1197	zrmet_totarea( reg_ind_cnt) = totarea_mat(jm)
1198	zrmet_var( reg_ind_cnt) = var_mat(jm)
1199	zrmet_cnt( reg_ind_cnt) = cnt_mat(jm)
1200	!zrmet_min( reg_ind_cnt) = min_mat(jm)
1201	!zrmet_max( reg_ind_cnt) = max_mat(jm)
1202	zrmet_reg_id( reg_ind_cnt) = reg_id_mat(jm)
1203	zrmet_mask_id(reg_ind_cnt) = mask_id_mat(jm)
1204
1205	reg_ind_cnt = reg_ind_cnt + 1
1206	END DO
1207
1208
1209	IF(lwp .AND. verbose) WRITE(numout,*) 'dia_regmean about to deallocated arrays for ',kt,maskno
1210	DEALLOCATE(ave_mat,tot_mat,num_mat,var_mat,ssq_mat,cnt_mat,reg_id_mat,mask_id_mat,totarea_mat, area_mat)
1211	!DEALLOCATE(min_mat,max_mat)
1212
1213	IF(lwp .AND. verbose) WRITE(numout,*) 'dia_regmean deallocated arrays for ',kt,maskno
1214	IF(lwp .AND. ln_diaregmean_ascii ) CALL FLUSH(numdct_reg_txt)
1215	IF(lwp .AND. verbose) WRITE(numout,*) 'dia_regmean flushed region mean text for ',kt,maskno
1216	END DO
1217
1218	IF(lwp .AND. verbose) THEN ! Control print
1219	WRITE(numout,*) 'dia_regmean ready to start iom_put'
1220	CALL FLUSH(numout)
1221	ENDIF
1222
1223	!With current field_def.xml and iodef.xml, these fields must be output, so set to dummy values if not required.
1224
1225	IF ( ln_diaregmean_nc ) THEN
1226
1227	zrmet_out(:) = 0
1228	zrmet_val = 0
1229	tmp_name_iom = ''
1230
1231	IF(lwp .AND. verbose) WRITE(numout,*) 'dia_regmean ready to start iom_put: ',trim(tmp_name)
1232
1233	tmp_name_iom = trim(trim("reg_") // trim(tmp_name) // trim('_ave'))
1234	IF (iom_use(trim(tmp_name_iom))) THEN
1235	DO jm = 1,n_regions_output
1236	zrmet_val = zrmet_ave(jm)
1237	! if (zrmet_val .LT. -1e16) zrmet_val = -1e16
1238	! if (zrmet_val .GT. 1e16) zrmet_val = 1e16
1239	if (zrmet_val .NE. zrmet_val) zrmet_val = 1e20
1240	zrmet_out(jm) = zrmet_val
1241	END DO
1242	IF(lwp .AND. verbose) WRITE(numout,*) 'dia_regmean iom_put tmp_name_iom : ',trim(tmp_name_iom), zrmet_out(1)
1243	CALL iom_put(trim(tmp_name_iom), zrmet_out(:) )
1244	zrmet_out(:) = 0
1245	zrmet_val = 0
1246	tmp_name_iom = ''
1247	ENDIF
1248
1249	tmp_name_iom = trim(trim("reg_") // trim(tmp_name) // trim('_tot'))
1250	IF (iom_use(trim(tmp_name_iom))) THEN
1251	DO jm = 1,n_regions_output
1252	zrmet_val = zrmet_tot(jm)
1253	! if (zrmet_val .LT. -1e16) zrmet_val = -1e16
1254	! if (zrmet_val .GT. 1e16) zrmet_val = 1e16
1255	if (zrmet_val .NE. zrmet_val) zrmet_val = 1e20
1256	zrmet_out(jm) = zrmet_val
1257	END DO
1258	IF(lwp .AND. verbose) WRITE(numout,*) 'dia_regmean iom_put tmp_name_iom : ',trim(tmp_name_iom), zrmet_out(1)
1259	CALL iom_put( trim(tmp_name_iom), zrmet_out(:) )
1260	zrmet_out(:) = 0
1261	zrmet_val = 0
1262	tmp_name_iom = ''
1263	ENDIF
1264
1265
1266
1267	tmp_name_iom = trim(trim("reg_") // trim(tmp_name) // trim('_totarea'))
1268	IF (iom_use(trim(tmp_name_iom))) THEN
1269	DO jm = 1,n_regions_output
1270	zrmet_val = zrmet_totarea(jm)
1271	! if (zrmet_val .LT. -1e16) zrmet_val = -1e16
1272	! if (zrmet_val .GT. 1e16) zrmet_val = 1e16
1273	if (zrmet_val .NE. zrmet_val) zrmet_val = 1e20
1274	zrmet_out(jm) = zrmet_val
1275	END DO
1276	IF(lwp .AND. verbose) WRITE(numout,*) 'dia_regmean iom_put tmp_name_iom : ',trim(tmp_name_iom), zrmet_out(1)
1277	CALL iom_put( trim(tmp_name_iom), zrmet_out(:) )
1278	zrmet_out(:) = 0
1279	zrmet_val = 0
1280	tmp_name_iom = ''
1281	ENDIF
1282
1283	tmp_name_iom = trim(trim("reg_") // trim(tmp_name) // trim('_var'))
1284	IF (iom_use(trim(tmp_name_iom))) THEN
1285	DO jm = 1,n_regions_output
1286	zrmet_val = zrmet_var(jm)
1287	! if (zrmet_val .LT. -1e16) zrmet_val = -1e16
1288	! if (zrmet_val .GT. 1e16) zrmet_val = 1e16
1289	if (zrmet_val .NE. zrmet_val) zrmet_val = 1e20
1290	zrmet_out(jm) = zrmet_val
1291	END DO
1292	IF(lwp .AND. verbose) WRITE(numout,*) 'dia_regmean iom_put tmp_name_iom : ',trim(tmp_name_iom), zrmet_out(1)
1293	CALL iom_put( trim(tmp_name_iom), zrmet_out(:) )
1294	zrmet_out(:) = 0
1295	zrmet_val = 0
1296	tmp_name_iom = ''
1297	ENDIF
1298
1299	tmp_name_iom = trim(trim("reg_") // trim(tmp_name) // trim('_cnt'))
1300	IF (iom_use(trim(tmp_name_iom))) THEN
1301	DO jm = 1,n_regions_output
1302	zrmet_val = zrmet_cnt(jm)
1303	! if (zrmet_val .LT. -1e16) zrmet_val = -1e16
1304	! if (zrmet_val .GT. 1e16) zrmet_val = 1e16
1305	if (zrmet_val .NE. zrmet_val) zrmet_val = 1e20
1306	zrmet_out(jm) = zrmet_val
1307	END DO
1308	IF(lwp .AND. verbose) WRITE(numout,*) 'dia_regmean iom_put tmp_name_iom : ',trim(tmp_name_iom), zrmet_out(1)
1309	CALL iom_put( trim(tmp_name_iom), zrmet_out(:) )
1310	zrmet_out(:) = 0
1311	zrmet_val = 0
1312	tmp_name_iom = ''
1313	ENDIF
1314
1315	tmp_name_iom = trim(trim("reg_") // trim(tmp_name) // trim('_reg_id'))
1316	IF (iom_use(trim(tmp_name_iom))) THEN
1317	DO jm = 1,n_regions_output
1318	zrmet_val = zrmet_reg_id(jm)
1319	! if (zrmet_val .LT. -1e16) zrmet_val = -1e16
1320	! if (zrmet_val .GT. 1e16) zrmet_val = 1e16
1321	if (zrmet_val .NE. zrmet_val) zrmet_val = 1e20
1322	zrmet_out(jm) = zrmet_val
1323	END DO
1324	IF(lwp .AND. verbose) WRITE(numout,*) 'dia_regmean iom_put tmp_name_iom : ',trim(tmp_name_iom), zrmet_out(1)
1325	CALL iom_put( trim(tmp_name_iom), zrmet_out(:) )
1326	zrmet_out(:) = 0
1327	zrmet_val = 0
1328	tmp_name_iom = ''
1329	ENDIF
1330
1331	tmp_name_iom = trim(trim("reg_") // trim(tmp_name) // trim('_mask_id'))
1332	IF (iom_use(trim(tmp_name_iom))) THEN
1333	DO jm = 1,n_regions_output
1334	zrmet_val = zrmet_mask_id(jm)
1335	! if (zrmet_val .LT. -1e16) zrmet_val = -1e16
1336	! if (zrmet_val .GT. 1e16) zrmet_val = 1e16
1337	if (zrmet_val .NE. zrmet_val) zrmet_val = 1e20
1338	zrmet_out(jm) = zrmet_val
1339	END DO
1340	IF(lwp .AND. verbose) WRITE(numout,*) 'dia_regmean iom_put tmp_name_iom : ',trim(tmp_name_iom)
1341	CALL iom_put( trim(tmp_name_iom), zrmet_out(:) )
1342	zrmet_out(:) = 0
1343	zrmet_val = 0
1344	tmp_name_iom = ''
1345	ENDIF
1346
1347	! ELSE
1348	!
1349	! ALLOCATE( dummy_zrmet(jpi,jpj,n_regions_output), STAT= ierr )
1350	! IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate dummy_zrmet array' )
1351
1352	! DO jm = 1,n_regions_output
1353	! dummy_zrmet(:,:,jm) = real(jm,wp)
1354	! END DO
1355
1356	! DO jm = 1,9
1357	! !IF iom_use(trim(trim(trim("reg_") // trim(tmp_name) // trim('_ave')))) CALL iom_put( trim(trim("reg_") // trim(tmp_name) // trim('_ave')), dummy_zrmet )
1358	! !IF iom_use(trim(trim(trim("reg_") // trim(tmp_name) // trim('_tot')))) CALL iom_put( trim(trim("reg_") // trim(tmp_name) // trim('_tot')), dummy_zrmet )
1359	! !IF iom_use(trim(trim(trim("reg_") // trim(tmp_name) // trim('_var')))) CALL iom_put( trim(trim("reg_") // trim(tmp_name) // trim('_var')), dummy_zrmet )
1360	! !IF iom_use(trim(trim(trim("reg_") // trim(tmp_name) // trim('_cnt')))) CALL iom_put( trim(trim("reg_") // trim(tmp_name) // trim('_cnt')), dummy_zrmet )
1361	! !IF iom_use(trim(trim(trim("reg_") // trim(tmp_name) // trim('_reg_id')))) CALL iom_put( trim(trim("reg_") // trim(tmp_name) // trim('_reg_id')), dummy_zrmet )
1362	! !IF iom_use(trim(trim(trim("reg_") // trim(tmp_name) // trim('_mask_id')))) CALL iom_put( trim(trim("reg_") // trim(tmp_name) // trim('_mask_id')), dummy_zrmet )
1363
1364
1365	! tmp_name_iom = trim(trim("reg_") // trim(tmp_name) // trim('_ave'))
1366	! IF (iom_use(trim(tmp_name_iom))) THEN
1367	! CALL iom_put( trim(tmp_name_iom), dummy_zrmet(1,1,:) ) !dummy_zrmet(1,1,:) ) )
1368	! ENDIF
1369	! tmp_name_iom = trim(trim("reg_") // trim(tmp_name) // trim('_tot'))
1370	! IF (iom_use(trim(tmp_name_iom))) THEN
1371	! CALL iom_put( trim(tmp_name_iom), dummy_zrmet(1,1,:) ) !dummy_zrmet(1,1,:) ) )
1372	! ENDIF
1373	! tmp_name_iom = trim(trim("reg_") // trim(tmp_name) // trim('_var'))
1374	! IF (iom_use(trim(tmp_name_iom))) THEN
1375	! CALL iom_put( trim(tmp_name_iom), dummy_zrmet(1,1,:) ) !dummy_zrmet(1,1,:) ) )
1376	! ENDIF
1377	! tmp_name_iom = trim(trim("reg_") // trim(tmp_name) // trim('_cnt'))
1378	! IF (iom_use(trim(tmp_name_iom))) THEN
1379	! CALL iom_put( trim(tmp_name_iom), dummy_zrmet(1,1,:) ) !dummy_zrmet(1,1,:) ) )
1380	! ENDIF
1381	! tmp_name_iom = trim(trim("reg_") // trim(tmp_name) // trim('_reg_id'))
1382	! IF (iom_use(trim(tmp_name_iom))) THEN
1383	! CALL iom_put( trim(tmp_name_iom), dummy_zrmet(1,1,:) ) !dummy_zrmet(1,1,:) ) )
1384	! ENDIF
1385	! tmp_name_iom = trim(trim("reg_") // trim(tmp_name) // trim('_mask_id'))
1386	! IF (iom_use(trim(tmp_name_iom))) THEN
1387	! CALL iom_put( trim(tmp_name_iom), dummy_zrmet(1,1,:) ) !dummy_zrmet(1,1,:) ) )
1388	! ENDIF
1389	!
1390	! END DO
1391	!
1392	! DEALLOCATE( dummy_zrmet)
1393	ENDIF
1394
1395	DEALLOCATE(zrmet_ave,zrmet_tot,zrmet_totarea,zrmet_var,zrmet_cnt,zrmet_mask_id,zrmet_reg_id,zrmet_min,zrmet_max,zrmet_out)
1396
1397	IF(lwp .AND. verbose) THEN ! Control print
1398	WRITE(numout,*)
1399	WRITE(numout,*) 'dia_wri_region_mean finished for ', trim(tmp_name)
1400	WRITE(numout,*)
1401	CALL FLUSH(numout)
1402	ENDIF
1403
1404	END SUBROUTINE dia_wri_region_mean
1405
1406
1407	!!======================================================================
1408	END MODULE diaregmean

Note: See TracBrowser for help on using the repository browser.

Download in other formats: