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

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

Last change on this file since 15434 was 15434, checked in by hadjt, 11 months ago

Region mean and NOOS cross-sections

Use rcp (Specific heat capacity) from nemo physical constant

File size: 67.9 KB
Line 
1MODULE 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   !!----------------------------------------------------------------------
67CONTAINS
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 )
119901   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 )
123902   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) + (emp*tmask(:,:,1)*tsn(:,:,1,jp_tem)*3850.)
697            tmp_field_SBC_mat(:,:,8) = tmp_field_SBC_mat(:,:,8) + (emp*tmask(:,:,1)*tsn(:,:,1,jp_tem)*rcp)
698            name_SBC_mat(8) = 'empheat'
699            !tmp_field_SBC_mat(:,:,9) = tmp_field_SBC_mat(:,:,9) + (rnf*tmask(:,:,1)*tsn(:,:,1,jp_tem)*3850.)
700            tmp_field_SBC_mat(:,:,9) = tmp_field_SBC_mat(:,:,9) + (rnf*tmask(:,:,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   !!======================================================================
1408END MODULE diaregmean
Note: See TracBrowser for help on using the repository browser.