Changeset 8672
- Timestamp:
- 2017-11-03T16:40:54+01:00 (7 years ago)
- Location:
- branches/UKMO/CO6_shelfclimate_fabm/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 3 edited
-
DIA/diaregmean.F90 (modified) (33 diffs)
-
DIA/diatmb.F90 (modified) (3 diffs)
-
IOM/iom.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/CO6_shelfclimate_fabm/NEMOGCM/NEMO/OPA_SRC/DIA/diaregmean.F90
r7613 r8672 11 11 USE iom ! I/0 library 12 12 USE wrk_nemo ! working arrays 13 USE diatmb ! Top,middle,bottom output 14 USE diapea ! Top,middle,bottom output 13 USE diapea ! PEA 15 14 USE zdfmxl ! MLD 16 15 USE sbc_oce … … 18 17 USE diaar5 19 18 #endif 19 20 21 #if defined key_fabm 22 USE trc 23 USE par_fabm 24 #endif 25 20 26 IMPLICIT NONE 21 27 PRIVATE … … 23 29 LOGICAL , PUBLIC :: ln_diaregmean ! region mean calculation 24 30 PUBLIC dia_regmean_init ! routine called by nemogcm.F90 25 PUBLIC dia_regmean ! routine called by diawri.F90 31 PUBLIC dia_regmean ! routine called by diawri.F90 32 PUBLIC dia_calctmb_region_mean ! routine called by diatmb.F90 33 26 34 27 35 28 29 30 31 LOGICAL :: ln_diaregmean_ascii ! region mean calculation ascii output 32 LOGICAL :: ln_diaregmean_bin ! region mean calculation binary output 33 LOGICAL :: ln_diaregmean_nc ! region mean calculation netcdf output 34 LOGICAL :: ln_diaregmean_diaar5 ! region mean calculation including AR5 SLR terms 35 LOGICAL :: ln_diaregmean_diasbc ! region mean calculation including Surface BC 36 LOGICAL :: ln_diaregmean_karamld ! region mean calculation including kara mld terms 37 LOGICAL :: ln_diaregmean_pea ! region mean calculation including pea terms 36 LOGICAL :: ln_diaregmean_ascii ! region mean calculation ascii output 37 LOGICAL :: ln_diaregmean_bin ! region mean calculation binary output 38 LOGICAL :: ln_diaregmean_nc ! region mean calculation netcdf output 39 LOGICAL :: ln_diaregmean_diaar5 ! region mean calculation including AR5 SLR terms 40 LOGICAL :: ln_diaregmean_diasbc ! region mean calculation including Surface BC 41 LOGICAL :: ln_diaregmean_karamld ! region mean calculation including kara mld terms 42 LOGICAL :: ln_diaregmean_pea ! region mean calculation including pea terms 43 44 45 LOGICAL :: ln_diaregmean_bgc ! region mean calculation including BGC terms 46 47 38 48 39 49 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: tmp_region_mask_real ! tempory region_mask of reals 40 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:,:,:):: region_mask ! region_mask matrix50 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: region_mask ! region_mask matrix 41 51 INTEGER :: nmasks ! Number of mask files in region_mask.nc file - 42 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:):: nreg_mat ! Number of regions in each mask52 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: nreg_mat ! Number of regions in each mask 43 53 44 54 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: tmp_field_mat !: temporary region_mask … … 74 84 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 75 85 INTEGER :: zndims ! number of dimensions in an array (i.e. 3, ) 86 87 88 #if defined key_fabm 89 INTEGER :: js,jl,jn, tmp_dummy 90 91 CHARACTER (len=120) :: tmp_name,tmp_long_name, tmp_unit 92 93 INTEGER :: BGC_nlevs,nBGC_output, bgci 94 CHARACTER(len = 10), ALLOCATABLE, DIMENSION(:) :: BGC_stat_name(:),BGC_lev_name(:),BGC_output_var(:) 95 #endif 96 76 97 ! 77 98 NAMELIST/nam_diaregmean/ ln_diaregmean,ln_diaregmean_ascii,ln_diaregmean_bin,ln_diaregmean_nc,& 78 & ln_diaregmean_karamld, ln_diaregmean_pea,ln_diaregmean_diaar5,ln_diaregmean_diasbc 99 & ln_diaregmean_karamld, ln_diaregmean_pea,ln_diaregmean_diaar5,ln_diaregmean_diasbc,ln_diaregmean_bgc 79 100 80 101 … … 104 125 WRITE(numout,*) 'Switch for regmean AR5 SLR terms (T) or not (F) ln_diaregmean_diaar5 = ', ln_diaregmean_diaar5 105 126 WRITE(numout,*) 'Switch for regmean Surface forcing terms (T) or not (F) ln_diaregmean_diasbc = ', ln_diaregmean_diasbc 127 WRITE(numout,*) 'Switch for regmean BioGeoChemistry terms (T) or not (F) ln_diaregmean_bgc = ', ln_diaregmean_bgc 106 128 ENDIF 107 129 108 130 109 !ALLOCATE( tmp_field_mat(jpi,jpj,7), STAT= ierr ) !SS/NB/DT T/S, SSH, MLD, PEA, PEAT, PEAS 110 ALLOCATE( tmp_field_mat(jpi,jpj,11), STAT= ierr ) !SS/NB/DT T/S, SSH, MLD, PEA, PEAT, PEAS 111 IF( ierr /= 0 ) CALL ctl_stop( 'tmp_field_mat: failed to allocate tmp_region_mask_real array' ) 131 ALLOCATE( tmp_field_mat(jpi,jpj,19), STAT= ierr ) !SS/NB/DT/ZA/VA T/S, SSH, MLD, PEA, PEAT, PEAS 132 IF( ierr /= 0 ) CALL ctl_stop( 'tmp_field_mat: failed to allocate tmp_field_mat array' ) 112 133 tmp_field_mat(:,:,:) = 0. 113 134 tmp_field_cnt = 0 114 135 115 136 IF(ln_diaregmean_diaar5) THEN 116 ALLOCATE( tmp_field_AR5_mat(jpi,jpj,4), STAT= ierr ) !S S/NB/DT T/S, SSH, MLD, PEA, PEAT, PEAS117 IF( ierr /= 0 ) CALL ctl_stop( 'tmp_field_AR5_mat: failed to allocate tmp_ region_mask_realarray' )137 ALLOCATE( tmp_field_AR5_mat(jpi,jpj,4), STAT= ierr ) !SLR terms 138 IF( ierr /= 0 ) CALL ctl_stop( 'tmp_field_AR5_mat: failed to allocate tmp_field_AR5_mat array' ) 118 139 tmp_field_AR5_mat(:,:,:) = 0. 119 140 ENDIF 120 141 121 142 IF(ln_diaregmean_diasbc) THEN 122 ALLOCATE( tmp_field_SBC_mat(jpi,jpj,7), STAT= ierr ) !S S/NB/DT T/S, SSH, MLD, PEA, PEAT, PEAS123 IF( ierr /= 0 ) CALL ctl_stop( 'tmp_field_SBC_mat: failed to allocate tmp_ region_mask_realarray' )143 ALLOCATE( tmp_field_SBC_mat(jpi,jpj,7), STAT= ierr ) !SBC terms 144 IF( ierr /= 0 ) CALL ctl_stop( 'tmp_field_SBC_mat: failed to allocate tmp_field_SBC_mat array' ) 124 145 tmp_field_SBC_mat(:,:,:) = 0. 125 146 ENDIF 147 148 149 #if defined key_fabm 150 ! as there are so many BGC variables, write out the necessary iodef.xml and field_def.xml entries into ocean.output 151 152 IF(ln_diaregmean_bgc) THEN 153 IF(lwp) THEN ! Control print 154 155 BGC_nlevs = 5 156 ALLOCATE( BGC_stat_name(6),BGC_lev_name(BGC_nlevs)) 157 nBGC_output = 16 158 ALLOCATE( BGC_output_var(nBGC_output)) 159 160 BGC_output_var(1) = 'N1_p' 161 BGC_output_var(2) = 'N3_n' 162 BGC_output_var(3) = 'N4_n' 163 BGC_output_var(4) = 'N5_s' 164 BGC_output_var(5) = 'O2_o' 165 BGC_output_var(6) = 'P1_Chl' 166 BGC_output_var(7) = 'P2_Chl' 167 BGC_output_var(8) = 'P3_Chl' 168 BGC_output_var(9) = 'P4_Chl' 169 BGC_output_var(10) = 'P1_c' 170 BGC_output_var(11) = 'P2_c' 171 BGC_output_var(12) = 'P3_c' 172 BGC_output_var(13) = 'P4_c' 173 BGC_output_var(14) = 'Z4_c' 174 BGC_output_var(15) = 'Z5_c' 175 BGC_output_var(16) = 'Z6_c' 176 177 BGC_stat_name(1) = '_ave' 178 BGC_stat_name(2) = '_tot' 179 BGC_stat_name(3) = '_var' 180 BGC_stat_name(4) = '_cnt' 181 BGC_stat_name(5) = '_reg_id' 182 BGC_stat_name(6) = '_mask_id' 183 BGC_lev_name(1) = 'top' 184 BGC_lev_name(2) = 'bot' 185 BGC_lev_name(3) = 'dif' 186 BGC_lev_name(4) = 'zav' 187 BGC_lev_name(5) = 'vol' 188 189 190 WRITE(numout,*) '' 191 WRITE(numout,*) 'diaregmean BGC field_def.xml entries' 192 WRITE(numout,*) '' 193 194 195 DO jn=1,jp_fabm ! State loop 196 DO js=1,6 197 DO jl=1,BGC_nlevs 198 199 tmp_name=TRIM( TRIM("reg_")//TRIM(BGC_lev_name(jl))//TRIM("_")//TRIM(ctrcnm(jn))// TRIM(BGC_stat_name(js)) ) 200 201 tmp_long_name = TRIM(ctrcln(jn)) 202 tmp_unit = TRIM(ctrcun(jn)) 203 204 ! Where using volume integrated values, change units... 205 206 IF ((jl .EQ. 5) .AND. (js .EQ. 2)) then 207 SELECT CASE (trim(tmp_unit)) 208 CASE ('mg C/m^3') ; tmp_unit = 'Mg C (T C)' !'mg C/m^3' 209 CASE ('mg/m^3') ; tmp_unit = 'Mg (T)' !'mg/m^3' 210 CASE ('mmol C/m^3') ; tmp_unit = 'Mmol C' !'mmol C/m^3' 211 CASE ('mmol N/m^3') ; tmp_unit = 'Mmol N' !'mmol N/m^3' 212 CASE ('mmol O_2/m^3') ; tmp_unit = 'Mmol O' !'mmol O_2/m^3' 213 CASE ('mmol P/m^3') ; tmp_unit = 'Mmol P' !'mmol P/m^3' 214 CASE ('mmol Si/m^3') ; tmp_unit = 'Mmol S' !'mmol Si/m^3' 215 CASE ('umol/kg') ; tmp_unit = 'Mmol' !'umol/kg' = mmol/m^3 216 ! CASE ('1/m') ; cycle 217 CASE DEFAULT 218 tmp_unit = TRIM(TRIM(tmp_unit)//TRIM('x 1e9 m^3')) 219 END SELECT 220 ENDIF 221 222 WRITE(numout,*) TRIM(TRIM('<field id="')//TRIM(tmp_name)//TRIM('" long_name="')// & 223 & TRIM(BGC_lev_name(jl))//TRIM('_')//TRIM(tmp_long_name)//TRIM(BGC_stat_name(js))// & 224 & TRIM('" unit="'//TRIM(tmp_unit) //'" />')) 225 226 END DO 227 END DO 228 END DO 229 230 WRITE(numout,*) '' 231 WRITE(numout,*) 'diaregmean BGC iodef.xml entries' 232 WRITE(numout,*) '' 233 DO js=1,6 234 235 DO jn=1,jp_fabm ! State loop 236 237 DO bgci=1,nBGC_output! 238 if (trim(ctrcnm(jn)) == TRIM(BGC_output_var(bgci))) CYCLE 239 ENDDO 240 DO jl=1,BGC_nlevs 241 ! only print out area averages for ss, nb, diff, and depth averaged, and total values for volume integrated 242 IF ((jl .EQ. 5) .AND. (js .NE. 2)) CYCLE ! cycle if vol, and not tot. 243 IF ((jl .NE. 5) .AND. (js .NE. 1)) CYCLE ! cycle if other levels, and not ave. 244 245 tmp_name=TRIM(TRIM("reg_")//TRIM(BGC_lev_name(jl))//TRIM("_")//TRIM(ctrcnm(jn))// TRIM(BGC_stat_name(js))) 246 tmp_long_name = TRIM(ctrcln(jn)) 247 248 WRITE(numout,*) TRIM(TRIM('<field field_ref="')//TRIM(tmp_name)//TRIM('"/>')) 249 250 END DO !level 251 END DO ! State loop 252 END DO !statistic 253 WRITE(numout,*) '' 254 DEALLOCATE( BGC_stat_name,BGC_lev_name) 255 256 ENDIF ! Control print 257 258 ENDIF !ln_diaregmean_bgc 259 260 #endif 261 126 262 127 263 IF (ln_diaregmean) THEN … … 136 272 IF( ierr /= 0 ) CALL ctl_stop( 'dia_regmean_init: failed to allocate tmp_region_mask_real array' ) 137 273 138 ! Use jpdom_unknown to read in a n 274 ! Use jpdom_unknown to read in a n-layer mask. 139 275 tmp_region_mask_real(:,:,:) = 0 140 276 CALL iom_get( inum, jpdom_unknown, 'mask', tmp_region_mask_real(1:nlci,1:nlcj,1:nmasks), & … … 168 304 IF ( ln_diaregmean_bin ) THEN 169 305 ! Open binary for region means 170 !OPEN( UNIT=73, FILE='region_mean_timeseries.dat', FORM='UNFORMATTED', STATUS='REPLACE' )171 172 173 306 CALL ctl_opn( numdct_reg_bin ,'region_mean_timeseries.dat' , 'NEW', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, .TRUE. ) 174 175 176 307 ENDIF 177 308 178 309 IF ( ln_diaregmean_ascii ) THEN 179 310 ! Open text files for region means 180 !OPEN( UNIT=37, FILE='region_mean_timeseries.txt', FORM='FORMATTED', STATUS='REPLACE' )181 311 CALL ctl_opn( numdct_reg_txt ,'region_mean_timeseries.txt' , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .TRUE. ) 182 312 ENDIF … … 190 320 !! *** ROUTINE dia_calctmb_region_mean *** 191 321 !! 192 !! ** Purpose : Find the Top, Mid, Bottom and Top minus Bottom fields of water Column 322 !! ** Purpose : Find the Top, Bottom and Top minus Bottom fields of water Column 323 !! : and depth average, and volume and mass intergated values. 324 193 325 !! 194 326 !! ** Method : … … 206 338 ! Routine arguments 207 339 REAL(wp), DIMENSION(jpi, jpj, jpk), INTENT(IN ) :: pinfield ! Input 3d field and mask 208 !REAL(wp), DIMENSION(jpi, jpj, 4 ), INTENT( OUT) :: pouttmb ! Output top, middle, bottom and surface minus bed 209 REAL(wp), DIMENSION(jpi, jpj, 3 ), INTENT( OUT) :: pouttmb ! Output top, middle, bottom and surface minus bed 340 REAL(wp), DIMENSION(jpi, jpj, 6 ), INTENT( OUT) :: pouttmb ! Output top, bottom and surface minus bed, zav, vol int, mass int 210 341 211 342 ! Local variables … … 214 345 ! Local Real 215 346 REAL(wp) :: zmdi ! set masked values 347 ! for depth int 348 REAL(wp) :: tmpnumer,tmpnumer_mass,tmpdenom ,z_av_val,vol_int_val 216 349 217 350 zmdi=1.e+20 !missing data indicator for masking 351 352 !zmdi=0 !missing data indicator for masking 218 353 219 354 ! Calculate top … … 231 366 DO jj = 1,jpj 232 367 DO ji = 1,jpi 233 jk = max(1,mbathy(ji,jj) - 1) 234 !pouttmb(ji,jj,3) = pinfield(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 235 !pouttmb(ji,jj,4) = (pouttmb(ji,jj,1) - pouttmb(ji,jj,3))*tmask(ji,jj,1) + zmdi*(1.0-tmask(ji,jj,1)) 236 pouttmb(ji,jj,2) = pinfield(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 237 pouttmb(ji,jj,3) = (pouttmb(ji,jj,1) - pouttmb(ji,jj,2))*tmask(ji,jj,1) + zmdi*(1.0-tmask(ji,jj,1)) 368 IF ( tmask(ji,jj,1) .EQ. 1) THEN ! if land 369 370 jk = max(1,mbathy(ji,jj) - 1) 371 pouttmb(ji,jj,2) = pinfield(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 372 373 pouttmb(ji,jj,3) = (pouttmb(ji,jj,1) - pouttmb(ji,jj,2))*tmask(ji,jj,1) + zmdi*(1.0-tmask(ji,jj,1)) 374 375 !Depth and volume integral: 376 !--------------------------- 377 !Vol int = Concentration * vol of grid box, summed over depth. 378 !Mass int = Concentration * vol of grid box * density of water, summed over depth. 379 !Depth Average = Vol int divided by * (vol of grid box summed over depth). 380 381 tmpnumer = 0. 382 tmpnumer_mass = 0. 383 tmpdenom = 0. 384 DO jk = 1,jpk 385 tmpnumer = tmpnumer + pinfield(ji,jj,jk)*tmask(ji,jj,jk)*e1t(ji,jj)*e2t(ji,jj)*e3t_n(ji,jj,jk) 386 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) 387 tmpdenom = tmpdenom + tmask(ji,jj,jk)*e1t(ji,jj)*e2t(ji,jj)*e3t_n(ji,jj,jk) 388 END DO 389 !z_av_val = tmpnumer/tmpdenom 390 !vol_int_val = tmpnumer 391 !mass_int_val = tmpnumer*density 392 393 pouttmb(ji,jj,4) = tmpnumer/tmpdenom ! depth averaged 394 pouttmb(ji,jj,5) = tmpnumer ! Vol integrated 395 pouttmb(ji,jj,6) = tmpnumer_mass ! Mass integrated (for heat and salt calcs) 396 ELSE 397 pouttmb(ji,jj,1) = zmdi 398 pouttmb(ji,jj,2) = zmdi 399 pouttmb(ji,jj,3) = zmdi 400 pouttmb(ji,jj,4) = zmdi 401 pouttmb(ji,jj,5) = zmdi 402 pouttmb(ji,jj,6) = zmdi 403 ENDIF 238 404 END DO 239 405 END DO … … 259 425 !! 260 426 !!-------------------------------------------------------------------- 427 REAL(wp), POINTER, DIMENSION(:,:,:) :: tmp1mat ! temporary array of 1's 261 428 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmbT ! temporary T workspace 262 429 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmbS ! temporary S workspace 263 REAL(wp) :: zmdi ! set masked values 430 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmb1 ! temporary density workspace 431 REAL(wp) :: zmdi ! set masked values 264 432 INTEGER, INTENT( in ) :: kt ! ocean time-step index 265 433 266 434 REAL(wp) :: zdt ! temporary reals 267 435 INTEGER :: i_steps, ierr ! no of timesteps per hour, allocation error index 268 INTEGER :: maskno,jj,ji,jm,nreg ! indices of mask, i and j, and number of regions 269 436 INTEGER :: maskno,jj,ji,jk,jm,nreg ! indices of mask, i and j, and number of regions 437 438 #if defined key_fabm 439 INTEGER :: jn ,tmp_dummy ! set masked values 440 REAL(wp) :: tmp_val ! tmp value, to allow min and max value clamping (not implemented) 441 INTEGER :: jl 442 CHARACTER (len=60) :: tmp_name_bgc_top,tmp_name_bgc_bot,tmp_name_bgc_dif, tmp_name_bgc_zav, tmp_name_bgc_vol 443 CHARACTER (len=60) :: tmp_output_filename 444 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmbBGC ! temporary BGC workspace 445 446 LOGICAL :: verbose 447 verbose = .FALSE. 448 tmp_val = 0 449 #endif 270 450 zmdi=1.e+20 !missing data indicator for maskin 271 451 … … 283 463 ENDIF 284 464 285 !i_steps = 1 465 ! Every time step, add physical, SBC, PEA, MLD terms to create hourly sums. 466 ! Every hour, then hourly sums are divided by the number of timesteps in the hour to make hourly means 467 ! These hourly mean values are then used to caluclate the regional means, and output with IOM. 468 #if defined key_fabm 469 ! BGC values are not averaged up over the hour, but are output as hourly instantaneous values. 470 #endif 471 286 472 287 473 !Extract 2d fields from 3d T and S with dia_calctmb_region_mean 288 CALL wrk_alloc( jpi , jpj, 3 , zwtmbT ) 289 CALL wrk_alloc( jpi , jpj, 3 , zwtmbS ) 474 CALL wrk_alloc( jpi , jpj, 6 , zwtmbT ) 475 CALL wrk_alloc( jpi , jpj, 6 , zwtmbS ) 476 CALL wrk_alloc( jpi , jpj, 6 , zwtmb1 ) 290 477 291 478 CALL dia_calctmb_region_mean( tsn(:,:,:,jp_tem),zwtmbT) 292 479 CALL dia_calctmb_region_mean( tsn(:,:,:,jp_sal),zwtmbS) 480 481 ! To calc regional mean time series of int vol and mass, run region mean code on array of 1's... 482 ! - then when multplying by volume, gives volume, 483 ! - then when multplying by volume*density, gives mass 484 485 CALL wrk_alloc( jpi , jpj, jpk , tmp1mat ) 486 DO jj = 1,jpj 487 DO ji = 1,jpi 488 DO jk = 1,jpk 489 tmp1mat(ji,jj,jk) = 1 490 END DO 491 END DO 492 END DO 493 494 CALL dia_calctmb_region_mean( tmp1mat,zwtmb1) 495 CALL wrk_dealloc( jpi , jpj, jpk , tmp1mat ) 496 497 ! Add 2d fields every time step to the hourly total. 293 498 294 tmp_field_mat(:,:,1) = tmp_field_mat(:,:,1) + (zwtmbT(:,:,1)*tmask(:,:,1)) 295 tmp_field_mat(:,:,2) = tmp_field_mat(:,:,2) + (zwtmbT(:,:,2)*tmask(:,:,1)) 296 tmp_field_mat(:,:,3) = tmp_field_mat(:,:,3) + (zwtmbT(:,:,3)*tmask(:,:,1)) 297 tmp_field_mat(:,:,4) = tmp_field_mat(:,:,4) + (zwtmbS(:,:,1)*tmask(:,:,1)) 298 tmp_field_mat(:,:,5) = tmp_field_mat(:,:,5) + (zwtmbS(:,:,2)*tmask(:,:,1)) 299 tmp_field_mat(:,:,6) = tmp_field_mat(:,:,6) + (zwtmbS(:,:,3)*tmask(:,:,1)) 300 tmp_field_mat(:,:,7) = tmp_field_mat(:,:,7) + (sshn(:,:)*tmask(:,:,1)) 301 499 tmp_field_mat(:,:,1) = tmp_field_mat(:,:,1) + (zwtmbT(:,:,1)*tmask(:,:,1)) !sst 500 tmp_field_mat(:,:,2) = tmp_field_mat(:,:,2) + (zwtmbT(:,:,2)*tmask(:,:,1)) !nbt 501 tmp_field_mat(:,:,3) = tmp_field_mat(:,:,3) + (zwtmbT(:,:,3)*tmask(:,:,1)) !dft 502 503 tmp_field_mat(:,:,4) = tmp_field_mat(:,:,4) + (zwtmbT(:,:,4)*tmask(:,:,1)) !zat 504 tmp_field_mat(:,:,5) = tmp_field_mat(:,:,5) + (zwtmbT(:,:,5)*tmask(:,:,1)) !vat 505 tmp_field_mat(:,:,6) = tmp_field_mat(:,:,6) + ((zwtmbT(:,:,6)*tmask(:,:,1)*4.2e3))! heat 506 507 tmp_field_mat(:,:,7) = tmp_field_mat(:,:,7) + (zwtmbS(:,:,1)*tmask(:,:,1)) !sss 508 tmp_field_mat(:,:,8) = tmp_field_mat(:,:,8) + (zwtmbS(:,:,2)*tmask(:,:,1)) !nbs 509 tmp_field_mat(:,:,9) = tmp_field_mat(:,:,9) + (zwtmbS(:,:,3)*tmask(:,:,1)) !dfs 510 511 tmp_field_mat(:,:,10) = tmp_field_mat(:,:,10) + (zwtmbS(:,:,4)*tmask(:,:,1)) !zas 512 tmp_field_mat(:,:,11) = tmp_field_mat(:,:,11) + (zwtmbS(:,:,5)*tmask(:,:,1)) !vas 513 tmp_field_mat(:,:,12) = tmp_field_mat(:,:,12) + (zwtmbS(:,:,6)*tmask(:,:,1)) !salt 514 515 tmp_field_mat(:,:,13) = tmp_field_mat(:,:,13) + (zwtmb1(:,:,5)*tmask(:,:,1))!vol 516 tmp_field_mat(:,:,14) = tmp_field_mat(:,:,14) + (zwtmb1(:,:,6)*tmask(:,:,1))!mass 517 518 tmp_field_mat(:,:,15) = tmp_field_mat(:,:,15) + (sshn(:,:)*tmask(:,:,1)) !ssh 519 520 CALL wrk_dealloc( jpi , jpj, 6 , zwtmbT ) 521 CALL wrk_dealloc( jpi , jpj, 6 , zwtmbS ) 522 CALL wrk_dealloc( jpi , jpj, 6 , zwtmb1 ) 302 523 303 524 IF( ln_diaregmean_karamld ) THEN 304 tmp_field_mat(:,:,8) = tmp_field_mat(:,:,8) + (hmld_kara(:,:)*tmask(:,:,1)) !hmlp(:,:)525 tmp_field_mat(:,:,16) = tmp_field_mat(:,:,16) + (hmld_kara(:,:)*tmask(:,:,1)) !mldkara 305 526 ENDIF 527 306 528 IF( ln_diaregmean_pea ) THEN 307 tmp_field_mat(:,:,9) = tmp_field_mat(:,:,9) + (pea(:,:)*tmask(:,:,1))308 tmp_field_mat(:,:,10) = tmp_field_mat(:,:,10) + (peat(:,:)*tmask(:,:,1))309 tmp_field_mat(:,:,11) = tmp_field_mat(:,:,11) + (peas(:,:)*tmask(:,:,1))529 tmp_field_mat(:,:,17) = tmp_field_mat(:,:,17) + (pea(:,:)*tmask(:,:,1)) !pea 530 tmp_field_mat(:,:,18) = tmp_field_mat(:,:,18) + (peat(:,:)*tmask(:,:,1)) !peat 531 tmp_field_mat(:,:,19) = tmp_field_mat(:,:,19) + (peas(:,:)*tmask(:,:,1)) !peas 310 532 ENDIF 311 533 … … 315 537 tmp_field_AR5_mat(:,:,3) = tmp_field_AR5_mat(:,:,3) + (sshhlster_mat(:,:)*tmask(:,:,1)) 316 538 tmp_field_AR5_mat(:,:,4) = tmp_field_AR5_mat(:,:,4) + (zbotpres_mat(:,:)*tmask(:,:,1)) 317 318 539 ENDIF 319 540 320 541 IF( ln_diaregmean_diasbc ) THEN 321 322 542 tmp_field_SBC_mat(:,:,1) = tmp_field_SBC_mat(:,:,1) + ((qsr + qns)*tmask(:,:,1)) 323 543 tmp_field_SBC_mat(:,:,2) = tmp_field_SBC_mat(:,:,2) + (qsr*tmask(:,:,1)) … … 327 547 tmp_field_SBC_mat(:,:,6) = tmp_field_SBC_mat(:,:,6) + (pressnow*tmask(:,:,1)) 328 548 tmp_field_SBC_mat(:,:,7) = tmp_field_SBC_mat(:,:,7) + (rnf*tmask(:,:,1)) 329 330 331 549 ENDIF 550 551 332 552 333 553 tmp_field_cnt = tmp_field_cnt + 1 334 335 IF( MOD( kt, i_steps ) == 0 .and. kt .ne. nn_it000 ) THEN 336 337 338 CALL dia_wri_region_mean(kt, "sst" , tmp_field_mat(:,:,1)/real(tmp_field_cnt,wp)) 339 CALL dia_wri_region_mean(kt, "nbt" , tmp_field_mat(:,:,2)/real(tmp_field_cnt,wp)) 340 CALL dia_wri_region_mean(kt, "dft" , tmp_field_mat(:,:,3)/real(tmp_field_cnt,wp)) 341 342 CALL dia_wri_region_mean(kt, "sss" , tmp_field_mat(:,:,4)/real(tmp_field_cnt,wp)) 343 CALL dia_wri_region_mean(kt, "nbs" , tmp_field_mat(:,:,5)/real(tmp_field_cnt,wp)) 344 CALL dia_wri_region_mean(kt, "dfs" , tmp_field_mat(:,:,6)/real(tmp_field_cnt,wp)) 345 346 CALL dia_wri_region_mean(kt, "ssh" , tmp_field_mat(:,:,7)/real(tmp_field_cnt,wp)) 347 348 349 IF( ln_diaregmean_karamld ) THEN 350 351 CALL dia_wri_region_mean(kt, "mldkara" , tmp_field_mat(:,:,8)/real(tmp_field_cnt,wp)) ! tm 352 ENDIF 353 IF( ln_diaregmean_pea ) THEN 354 355 CALL dia_wri_region_mean(kt, "pea" , tmp_field_mat(:,:,9)/real(tmp_field_cnt,wp)) 356 CALL dia_wri_region_mean(kt, "peat" , tmp_field_mat(:,:,10)/real(tmp_field_cnt,wp)) 357 CALL dia_wri_region_mean(kt, "peas" , tmp_field_mat(:,:,11)/real(tmp_field_cnt,wp)) ! tmb 358 ENDIF 359 360 tmp_field_mat(:,:,:) = 0. 361 362 IF( ln_diaregmean_diaar5 ) THEN 363 364 CALL dia_wri_region_mean(kt, "ssh_steric" , tmp_field_AR5_mat(:,:,1)/real(tmp_field_cnt,wp)) 365 CALL dia_wri_region_mean(kt, "ssh_thermosteric", tmp_field_AR5_mat(:,:,2)/real(tmp_field_cnt,wp)) 366 CALL dia_wri_region_mean(kt, "ssh_halosteric" , tmp_field_AR5_mat(:,:,3)/real(tmp_field_cnt,wp)) 367 CALL dia_wri_region_mean(kt, "bot_pres" , tmp_field_AR5_mat(:,:,4)/real(tmp_field_cnt,wp)) 368 tmp_field_AR5_mat(:,:,:) = 0. 369 ENDIF 370 371 IF( ln_diaregmean_diasbc ) THEN 372 373 CALL dia_wri_region_mean(kt, "qt" , tmp_field_SBC_mat(:,:,1)/real(tmp_field_cnt,wp)) 374 CALL dia_wri_region_mean(kt, "qsr" , tmp_field_SBC_mat(:,:,2)/real(tmp_field_cnt,wp)) 375 CALL dia_wri_region_mean(kt, "qns" , tmp_field_SBC_mat(:,:,3)/real(tmp_field_cnt,wp)) 376 CALL dia_wri_region_mean(kt, "emp" , tmp_field_SBC_mat(:,:,4)/real(tmp_field_cnt,wp)) 377 CALL dia_wri_region_mean(kt, "wspd" , tmp_field_SBC_mat(:,:,5)/real(tmp_field_cnt,wp)) 378 CALL dia_wri_region_mean(kt, "mslp" , tmp_field_SBC_mat(:,:,6)/real(tmp_field_cnt,wp)) 379 CALL dia_wri_region_mean(kt, "rnf" , tmp_field_SBC_mat(:,:,7)/real(tmp_field_cnt,wp)) 380 tmp_field_SBC_mat(:,:,:) = 0. 381 ENDIF 382 383 tmp_field_cnt = 0 554 555 ! On the hour, calculate hourly means from the hourly total,and process the regional means. 556 557 IF ( MOD( kt, i_steps ) == 0 .and. kt .ne. nn_it000 ) THEN 558 559 560 CALL dia_wri_region_mean(kt, "sst" , tmp_field_mat(:,:,1)/real(tmp_field_cnt,wp)) 561 CALL dia_wri_region_mean(kt, "nbt" , tmp_field_mat(:,:,2)/real(tmp_field_cnt,wp)) 562 CALL dia_wri_region_mean(kt, "dft" , tmp_field_mat(:,:,3)/real(tmp_field_cnt,wp)) 563 564 CALL dia_wri_region_mean(kt, "zat" , tmp_field_mat(:,:,4)/real(tmp_field_cnt,wp)) 565 CALL dia_wri_region_mean(kt, "vat" , tmp_field_mat(:,:,5)/real(tmp_field_cnt,wp)) 566 CALL dia_wri_region_mean(kt, "heat" , tmp_field_mat(:,:,6)/real(tmp_field_cnt,wp)/1e12) 567 568 CALL dia_wri_region_mean(kt, "sss" , tmp_field_mat(:,:,7)/real(tmp_field_cnt,wp)) 569 CALL dia_wri_region_mean(kt, "nbs" , tmp_field_mat(:,:,8)/real(tmp_field_cnt,wp)) 570 CALL dia_wri_region_mean(kt, "dfs" , tmp_field_mat(:,:,9)/real(tmp_field_cnt,wp)) 571 572 CALL dia_wri_region_mean(kt, "zas" , tmp_field_mat(:,:,10)/real(tmp_field_cnt,wp)) 573 CALL dia_wri_region_mean(kt, "vas" , tmp_field_mat(:,:,11)/real(tmp_field_cnt,wp)) 574 CALL dia_wri_region_mean(kt, "salt" , tmp_field_mat(:,:,12)/real(tmp_field_cnt,wp)/1e12) 575 576 CALL dia_wri_region_mean(kt, "vol" , tmp_field_mat(:,:,13)/real(tmp_field_cnt,wp)) 577 CALL dia_wri_region_mean(kt, "mass" , tmp_field_mat(:,:,14)/real(tmp_field_cnt,wp)) 578 579 CALL dia_wri_region_mean(kt, "ssh" , tmp_field_mat(:,:,15)/real(tmp_field_cnt,wp)) 580 581 582 IF( ln_diaregmean_karamld ) THEN 583 CALL dia_wri_region_mean(kt, "mldkara" , tmp_field_mat(:,:,16)/real(tmp_field_cnt,wp)) ! tm 584 ENDIF 585 586 IF( ln_diaregmean_pea ) THEN 587 CALL dia_wri_region_mean(kt, "pea" , tmp_field_mat(:,:,17)/real(tmp_field_cnt,wp)) 588 CALL dia_wri_region_mean(kt, "peat" , tmp_field_mat(:,:,18)/real(tmp_field_cnt,wp)) 589 CALL dia_wri_region_mean(kt, "peas" , tmp_field_mat(:,:,19)/real(tmp_field_cnt,wp)) ! tmb 590 ENDIF 591 592 tmp_field_mat(:,:,:) = 0. 593 594 IF( ln_diaregmean_diaar5 ) THEN 595 596 CALL dia_wri_region_mean(kt, "ssh_steric" , tmp_field_AR5_mat(:,:,1)/real(tmp_field_cnt,wp)) 597 CALL dia_wri_region_mean(kt, "ssh_thermosteric", tmp_field_AR5_mat(:,:,2)/real(tmp_field_cnt,wp)) 598 CALL dia_wri_region_mean(kt, "ssh_halosteric" , tmp_field_AR5_mat(:,:,3)/real(tmp_field_cnt,wp)) 599 CALL dia_wri_region_mean(kt, "bot_pres" , tmp_field_AR5_mat(:,:,4)/real(tmp_field_cnt,wp)) 600 tmp_field_AR5_mat(:,:,:) = 0. 601 ENDIF 602 603 IF( ln_diaregmean_diasbc ) THEN 604 605 CALL dia_wri_region_mean(kt, "qt" , tmp_field_SBC_mat(:,:,1)/real(tmp_field_cnt,wp)) 606 CALL dia_wri_region_mean(kt, "qsr" , tmp_field_SBC_mat(:,:,2)/real(tmp_field_cnt,wp)) 607 CALL dia_wri_region_mean(kt, "qns" , tmp_field_SBC_mat(:,:,3)/real(tmp_field_cnt,wp)) 608 CALL dia_wri_region_mean(kt, "emp" , tmp_field_SBC_mat(:,:,4)/real(tmp_field_cnt,wp)) 609 CALL dia_wri_region_mean(kt, "wspd" , tmp_field_SBC_mat(:,:,5)/real(tmp_field_cnt,wp)) 610 CALL dia_wri_region_mean(kt, "mslp" , tmp_field_SBC_mat(:,:,6)/real(tmp_field_cnt,wp)) 611 CALL dia_wri_region_mean(kt, "rnf" , tmp_field_SBC_mat(:,:,7)/real(tmp_field_cnt,wp)) 612 tmp_field_SBC_mat(:,:,:) = 0. 613 ENDIF 614 615 #if defined key_fabm 616 !ADD Biogeochemistry 617 618 IF( ln_diaregmean_bgc ) THEN !ln_diaregmean_bgc 619 620 ! Loop through 3d BGC tracers 621 DO jn=1,jp_fabm ! State loop 622 623 ! get variable name for different levels 624 tmp_name_bgc_top=TRIM(TRIM("top_")//TRIM(ctrcnm(jn))) 625 tmp_name_bgc_bot=TRIM(TRIM("bot_")//TRIM(ctrcnm(jn))) 626 tmp_name_bgc_dif=TRIM(TRIM("dif_")//TRIM(ctrcnm(jn))) 627 tmp_name_bgc_zav=TRIM(TRIM("zav_")//TRIM(ctrcnm(jn))) 628 tmp_name_bgc_vol=TRIM(TRIM("vol_")//TRIM(ctrcnm(jn))) 629 630 ! print out names if verbose 631 IF(verbose .AND. lwp) THEN 632 WRITE(numout,*) 633 WRITE(numout,*) 'dia_regmean tmp_name_bgc_top : ',TRIM(tmp_name_bgc_top) 634 WRITE(numout,*) 'dia_regmean tmp_name_bgc_bot : ',TRIM(tmp_name_bgc_bot) 635 WRITE(numout,*) 'dia_regmean tmp_name_bgc_dif : ',TRIM(tmp_name_bgc_dif) 636 WRITE(numout,*) 'dia_regmean tmp_name_bgc_zav : ',TRIM(tmp_name_bgc_zav) 637 WRITE(numout,*) 'dia_regmean tmp_name_bgc_vol : ',TRIM(tmp_name_bgc_vol) 638 CALL FLUSH(numout) 639 640 ENDIF 641 642 !Allocate working array, and get surface, bed etc fields. 643 CALL wrk_alloc( jpi , jpj, 6 , zwtmbBGC ) 644 CALL dia_calctmb_region_mean( trn(:,:,:,jn),zwtmbBGC ) 645 646 647 !Print out 2d fields to ascii text files to check values if verbose. (24MB per time step, per BGC variable) 648 IF (verbose) THEN 649 650 WRITE (tmp_output_filename, "(A4,I3.3,A1,I6.6,A1,I3.3,A4)") "bgc_",jn,"_",kt,"_",narea,".txt" 651 WRITE (*,*) tmp_output_filename 652 OPEN(UNIT=74,FILE=TRIM(tmp_output_filename)) 653 654 DO ji = 1,jpi 655 DO jj = 1,jpj 656 WRITE(74,FMT="(I4,I4,F3,F25.5,F25.5,F25.5,F25.5,F25.5)") nimpp+ji, njmpp+jj,tmask(ji,jj,1),& 657 & zwtmbBGC(ji,jj,1),zwtmbBGC(ji,jj,2),zwtmbBGC(ji,jj,3),zwtmbBGC(ji,jj,4),zwtmbBGC(ji,jj,5)/1e9 658 END DO 659 END DO 660 CLOSE(74) 661 ENDIF 662 663 ! Do region means 664 CALL dia_wri_region_mean(kt, TRIM(tmp_name_bgc_top) , zwtmbBGC(:,:,1)) 665 CALL dia_wri_region_mean(kt, TRIM(tmp_name_bgc_bot) , zwtmbBGC(:,:,2)) 666 CALL dia_wri_region_mean(kt, TRIM(tmp_name_bgc_dif) , zwtmbBGC(:,:,3)) 667 CALL dia_wri_region_mean(kt, TRIM(tmp_name_bgc_zav) , zwtmbBGC(:,:,4)) 668 CALL dia_wri_region_mean(kt, TRIM(tmp_name_bgc_vol) , zwtmbBGC(:,:,5)/1e9) 669 670 671 !Deallocate working array 672 CALL wrk_dealloc( jpi , jpj, 6 , zwtmbBGC ) 673 ENDDO ! State loop 674 ENDIF !ln_diaregmean_bgc 675 676 #endif 677 678 tmp_field_cnt = 0 384 679 385 ENDIF 680 ENDIF ! ( MOD( kt, i_steps ) == 0 .and. kt .ne. nn_it000 ) 386 681 387 682 388 683 ! If on the last time step, close binary and ascii files. 389 684 IF( kt == nitend ) THEN 390 IF(lwp) THEN 391 IF ( ln_diaregmean_bin ) THEN 392 !Closing binary files for regional mean time series. 393 CLOSE(numdct_reg_bin) 685 IF(lwp) THEN 686 IF ( ln_diaregmean_bin ) THEN 687 !Closing binary files for regional mean time series. 688 CLOSE(numdct_reg_bin) 689 ENDIF 690 IF ( ln_diaregmean_ascii ) THEN 691 !Closing text files for regional mean time series. 692 CLOSE(numdct_reg_txt) 693 ENDIF 694 695 DEALLOCATE( region_mask, nreg_mat, tmp_field_mat) 696 IF( ln_diaregmean_diaar5 ) DEALLOCATE( tmp_field_AR5_mat) 697 IF( ln_diaregmean_diasbc ) DEALLOCATE( tmp_field_SBC_mat) 394 698 ENDIF 395 IF ( ln_diaregmean_ascii ) THEN396 !Closing text files for regional mean time series.397 CLOSE(numdct_reg_txt)398 ENDIF399 400 DEALLOCATE( region_mask, nreg_mat, tmp_field_mat)401 IF( ln_diaregmean_diaar5 ) DEALLOCATE( tmp_field_AR5_mat)402 IF( ln_diaregmean_diasbc ) DEALLOCATE( tmp_field_SBC_mat)403 ENDIF404 699 ENDIF 405 700 … … 412 707 413 708 414 SUBROUTINE dia_wri_region_mean(kt, name, infield )709 SUBROUTINE dia_wri_region_mean(kt, tmp_name, infield ) 415 710 !!--------------------------------------------------------------------- 416 711 !! *** ROUTINE dia_tmb *** … … 430 725 431 726 INTEGER, INTENT(in) :: kt 432 CHARACTER (len= 60) , INTENT(IN ) ::name727 CHARACTER (len=*) , INTENT(IN ) :: tmp_name 433 728 REAL(wp), DIMENSION(jpi, jpj), INTENT(IN ) :: infield ! Input 3d field and mask 434 729 435 730 ! Local variables 436 INTEGER, DIMENSION(jpi, jpj) :: internal_region_mask ! Input 3d field and mask 437 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zrmet_ave,zrmet_tot,zrmet_var,zrmet_cnt,zrmet_mask_id,zrmet_reg_id 731 INTEGER, DIMENSION(jpi, jpj) :: internal_region_mask ! Input 3d field and mask 732 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zrmet_ave,zrmet_tot,zrmet_var,zrmet_cnt,zrmet_mask_id,zrmet_reg_id ,zrmet_min,zrmet_max 438 733 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zrmet_out 439 REAL(wp), ALLOCATABLE, DIMENSION(:) :: ave_mat,tot_mat,num_mat,var_mat,ssq_mat,cnt_mat,reg_id_mat,mask_id_mat !: region_mask440 441 REAL(wp) :: zmdi ! set masked values734 REAL(wp), ALLOCATABLE, DIMENSION(:) :: ave_mat,tot_mat,num_mat,var_mat,ssq_mat,cnt_mat,reg_id_mat,mask_id_mat ,min_mat,max_mat !: region_mask 735 736 REAL(wp) :: zmdi, zrmet_val ! set masked values 442 737 INTEGER :: maskno,nreg ! ocean time-step indexocean time step 443 738 INTEGER :: ji,jj,jk,ind,jm ! Dummy loop indices … … 446 741 INTEGER :: ierr 447 742 REAL(wp) :: tmpreal 448 CHARACTER(LEN=180) :: FormatString,nreg_string 743 CHARACTER(LEN=180) :: FormatString,nreg_string,tmp_name_iom 449 744 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: dummy_zrmet 745 LOGICAL :: verbose 746 verbose = .FALSE. 747 748 450 749 zmdi=1.e+20 !missing data indicator for maskin 451 750 … … 463 762 ALLOCATE( zrmet_reg_id(n_regions_output), STAT= ierr ) 464 763 IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_reg_id array' ) 764 765 766 ALLOCATE( zrmet_min(n_regions_output), STAT= ierr ) 767 IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_min array' ) 768 ALLOCATE( zrmet_max(n_regions_output), STAT= ierr ) 769 IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_max array' ) 465 770 466 771 ALLOCATE( zrmet_out(jpi,jpj,n_regions_output), STAT= ierr ) 467 772 IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_reg_id array' ) 468 773 774 775 776 IF(lwp .AND. verbose) THEN 777 WRITE(numout,*) 778 WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//';' 779 WRITE(numout,*) 780 ENDIF 469 781 470 782 zrmet_ave(:) = zmdi … … 475 787 zrmet_reg_id(:) = zmdi 476 788 789 zrmet_min(:) = zmdi 790 zrmet_max(:) = zmdi 477 791 reg_ind_cnt = 1 478 792 … … 480 794 ! loop though the masks 481 795 DO maskno = 1,nmasks 796 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//'; begin mask loops: ',maskno 482 797 483 798 … … 499 814 ALLOCATE( cnt_mat(nreg), STAT= ierr ) 500 815 IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate cnt_mat array' ) 816 817 ALLOCATE( min_mat(nreg), STAT= ierr ) 818 IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate min_mat array' ) 819 ALLOCATE( max_mat(nreg), STAT= ierr ) 820 IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate max_mat array' ) 821 501 822 ALLOCATE( reg_id_mat(nreg), STAT= ierr ) 502 823 IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate reg_id_mat array' ) 503 824 ALLOCATE( mask_id_mat(nreg), STAT= ierr ) 504 825 IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate mask_id_mat array' ) 826 827 505 828 506 829 ave_mat(:) = 0. … … 510 833 cnt_mat(:) = 0. 511 834 ssq_mat(:) = 0. 835 836 min_mat(:) = zmdi 837 max_mat(:) = -zmdi 512 838 reg_id_mat(:) = 0. 513 839 mask_id_mat(:) = 0. … … 518 844 !CALL cpu_time(start_reg_mean_loop) 519 845 !WRITE(numout,*) kt,start_reg_mean_loop 846 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//'; begin spatial loops: ' 520 847 DO ji = 1,jpi 521 848 DO jj = 1,jpj … … 525 852 ssq_mat(ind) = ssq_mat(ind) + ( infield(ji,jj) * infield(ji,jj)) 526 853 cnt_mat(ind) = cnt_mat(ind) + 1. 854 855 min_mat(ind) = min(min_mat(ind),infield(ji,jj)) 856 max_mat(ind) = max(max_mat(ind),infield(ji,jj)) 527 857 ENDIF 528 858 END DO 529 859 END DO 860 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//'; finish spatial loops: ' 530 861 ! sum the totals, the counts, and the squares across the processors 531 862 CALL mpp_sum( tot_mat,nreg ) 863 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//'; finished mpp_sum 1' 532 864 CALL mpp_sum( ssq_mat,nreg ) 865 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//'; finished mpp_sum 2' 533 866 CALL mpp_sum( cnt_mat,nreg ) 867 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//'; finished mpp_sum 2' 868 869 CALL mpp_min( min_mat,nreg ) 870 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//'; finished mpp_min' 871 CALL mpp_max( max_mat,nreg ) 872 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//'; finished mpp_max' 534 873 535 874 … … 553 892 IF ( ln_diaregmean_bin ) THEN 554 893 !Writing out regional mean time series to binary files 555 WRITE(numdct_reg_bin) name,kt,maskno,n_regions_output894 WRITE(numdct_reg_bin) tmp_name,kt,maskno,n_regions_output 556 895 WRITE(numdct_reg_bin) ave_mat 557 896 WRITE(numdct_reg_bin) tot_mat … … 559 898 WRITE(numdct_reg_bin) ssq_mat 560 899 WRITE(numdct_reg_bin) cnt_mat 900 WRITE(numdct_reg_bin) min_mat 901 WRITE(numdct_reg_bin) max_mat 561 902 ENDIF 562 903 … … 565 906 566 907 WRITE(nreg_string, "(I5)") nreg 567 FormatString = "(A17,"//trim(nreg_string)//"F15.3)" 568 WRITE(numdct_reg_txt, FMT="(A17,I6,I6)") name,kt,maskno 569 WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(name)//" "//"ave_mat:", ave_mat 570 WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(name)//" "//"tot_mat:", tot_mat 571 WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(name)//" "//"var_mat:", var_mat 572 WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(name)//" "//"ssq_mat:", ssq_mat 573 WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(name)//" "//"cnt_mat:", cnt_mat 574 WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(name)//" "//"reg_mat:", reg_id_mat 575 WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(name)//" "//"msk_mat:", mask_id_mat 908 FormatString = "(A30,"//trim(nreg_string)//"F25.3)" 909 WRITE(numdct_reg_txt, FMT="(A30,I6,I6)") tmp_name,kt,maskno 910 WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(tmp_name)//" "//"ave_mat:", ave_mat 911 WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(tmp_name)//" "//"tot_mat:", tot_mat 912 WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(tmp_name)//" "//"var_mat:", var_mat 913 WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(tmp_name)//" "//"ssq_mat:", ssq_mat 914 WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(tmp_name)//" "//"cnt_mat:", cnt_mat 915 WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(tmp_name)//" "//"min_mat:", min_mat 916 WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(tmp_name)//" "//"max_mat:", max_mat 917 WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(tmp_name)//" "//"reg_mat:", reg_id_mat 918 WRITE(numdct_reg_txt, FMT=trim(FormatString)) trim(tmp_name)//" "//"msk_mat:", mask_id_mat 576 919 577 920 ENDIF … … 582 925 zrmet_var( reg_ind_cnt) = var_mat(jm) 583 926 zrmet_cnt( reg_ind_cnt) = cnt_mat(jm) 927 zrmet_min( reg_ind_cnt) = min_mat(jm) 928 zrmet_max( reg_ind_cnt) = max_mat(jm) 584 929 zrmet_reg_id( reg_ind_cnt) = reg_id_mat(jm) 585 930 zrmet_mask_id(reg_ind_cnt) = mask_id_mat(jm) … … 590 935 ENDIF 591 936 592 DEALLOCATE(ave_mat,tot_mat,num_mat,var_mat,ssq_mat,cnt_mat,reg_id_mat,mask_id_mat) 593 !DEALLOCATE(tot_mat_2) 937 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_regmean about to deallocated arrays for ',kt,maskno 938 DEALLOCATE(ave_mat,tot_mat,num_mat,var_mat,ssq_mat,cnt_mat,min_mat,max_mat,reg_id_mat,mask_id_mat) 939 940 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_regmean deallocated arrays for ',kt,maskno 941 IF(lwp)CALL FLUSH(numdct_reg_txt) 942 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_regmean flushed region mean text for ',kt,maskno 594 943 END DO 595 944 945 IF(lwp .AND. verbose) THEN ! Control print 946 WRITE(numout,*) 'dia_regmean ready to start iom_put' 947 CALL FLUSH(numout) 948 ENDIF 596 949 597 950 !With current field_def.xml and iodef.xml, these fields must be output, so set to dummy values if not required. … … 599 952 IF ( ln_diaregmean_nc ) THEN 600 953 601 954 zrmet_out(:,:,:) = 0 955 zrmet_val = 0 956 tmp_name_iom = '' 957 958 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_regmean ready to start iom_put: ',trim(tmp_name) 959 602 960 603 961 DO jm = 1,n_regions_output 604 zrmet_out(:,:,jm) = zrmet_ave(jm) 962 zrmet_val = zrmet_ave(jm) 963 ! if (zrmet_val .LT. -1e16) zrmet_val = -1e16 964 ! if (zrmet_val .GT. 1e16) zrmet_val = 1e16 965 ! if (zrmet_val .NE. zrmet_val) zrmet_val = 0. 966 zrmet_out(:,:,jm) = zrmet_val 605 967 END DO 606 CALL iom_put( "reg_" // trim(name) // '_ave', zrmet_out ) 968 tmp_name_iom = trim(trim("reg_") // trim(tmp_name) // trim('_ave')) 969 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_regmean iom_put tmp_name_iom : ',trim(tmp_name_iom) 970 CALL iom_put(trim(tmp_name_iom), zrmet_out ) 607 971 zrmet_out(:,:,:) = 0 972 zrmet_val = 0 973 tmp_name_iom = '' 608 974 609 975 DO jm = 1,n_regions_output 610 zrmet_out(:,:,jm) = zrmet_tot(jm) 611 END DO 612 CALL iom_put( "reg_" // trim(name) // '_tot', zrmet_out ) 976 zrmet_val = zrmet_tot(jm) 977 ! if (zrmet_val .LT. -1e16) zrmet_val = -1e16 978 ! if (zrmet_val .GT. 1e16) zrmet_val = 1e16 979 ! if (zrmet_val .NE. zrmet_val) zrmet_val = 0. 980 zrmet_out(:,:,jm) = zrmet_val 981 END DO 982 tmp_name_iom = trim(trim("reg_") // trim(tmp_name) // trim('_tot')) 983 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_regmean iom_put tmp_name_iom : ',trim(tmp_name_iom) 984 CALL iom_put( trim(tmp_name_iom), zrmet_out ) 613 985 zrmet_out(:,:,:) = 0 986 zrmet_val = 0 987 tmp_name_iom = '' 614 988 615 989 DO jm = 1,n_regions_output 616 zrmet_out(:,:,jm) = zrmet_var(jm) 617 END DO 618 CALL iom_put( "reg_" // trim(name) // '_var', zrmet_out ) 990 zrmet_val = zrmet_var(jm) 991 ! if (zrmet_val .LT. -1e16) zrmet_val = -1e16 992 ! if (zrmet_val .GT. 1e16) zrmet_val = 1e16 993 ! if (zrmet_val .NE. zrmet_val) zrmet_val = 0. 994 zrmet_out(:,:,jm) = zrmet_val 995 END DO 996 tmp_name_iom = trim(trim("reg_") // trim(tmp_name) // trim('_var')) 997 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_regmean iom_put tmp_name_iom : ',trim(tmp_name_iom) 998 CALL iom_put( trim(tmp_name_iom), zrmet_out ) 619 999 zrmet_out(:,:,:) = 0 1000 zrmet_val = 0 1001 tmp_name_iom = '' 620 1002 621 1003 DO jm = 1,n_regions_output 622 zrmet_out(:,:,jm) = zrmet_cnt(jm) 623 END DO 624 CALL iom_put( "reg_" // trim(name) // '_cnt', zrmet_out ) 1004 zrmet_val = zrmet_cnt(jm) 1005 ! if (zrmet_val .LT. -1e16) zrmet_val = -1e16 1006 ! if (zrmet_val .GT. 1e16) zrmet_val = 1e16 1007 ! if (zrmet_val .NE. zrmet_val) zrmet_val = 0. 1008 zrmet_out(:,:,jm) = zrmet_val 1009 END DO 1010 tmp_name_iom = trim(trim("reg_") // trim(tmp_name) // trim('_cnt')) 1011 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_regmean iom_put tmp_name_iom : ',trim(tmp_name_iom) 1012 CALL iom_put( trim(tmp_name_iom), zrmet_out ) 625 1013 zrmet_out(:,:,:) = 0 1014 zrmet_val = 0 1015 tmp_name_iom = '' 626 1016 627 1017 DO jm = 1,n_regions_output 628 zrmet_out(:,:,jm) = zrmet_reg_id(jm) 629 END DO 630 CALL iom_put( "reg_" // trim(name) // '_reg_id', zrmet_out ) 1018 zrmet_val = zrmet_reg_id(jm) 1019 ! if (zrmet_val .LT. -1e16) zrmet_val = -1e16 1020 ! if (zrmet_val .GT. 1e16) zrmet_val = 1e16 1021 ! if (zrmet_val .NE. zrmet_val) zrmet_val = 0. 1022 zrmet_out(:,:,jm) = zrmet_val 1023 END DO 1024 tmp_name_iom = trim(trim("reg_") // trim(tmp_name) // trim('_reg_id')) 1025 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_regmean iom_put tmp_name_iom : ',trim(tmp_name_iom) 1026 CALL iom_put( trim(tmp_name_iom), zrmet_out ) 631 1027 zrmet_out(:,:,:) = 0 1028 zrmet_val = 0 1029 tmp_name_iom = '' 632 1030 633 1031 DO jm = 1,n_regions_output 634 zrmet_out(:,:,jm) = zrmet_mask_id(jm) 635 END DO 636 CALL iom_put( "reg_" // trim(name) // '_mask_id', zrmet_out ) 1032 zrmet_val = zrmet_mask_id(jm) 1033 ! if (zrmet_val .LT. -1e16) zrmet_val = -1e16 1034 ! if (zrmet_val .GT. 1e16) zrmet_val = 1e16 1035 ! if (zrmet_val .NE. zrmet_val) zrmet_val = 0. 1036 zrmet_out(:,:,jm) = zrmet_val 1037 END DO 1038 tmp_name_iom = trim(trim("reg_") // trim(tmp_name) // trim('_mask_id')) 1039 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_regmean iom_put tmp_name_iom : ',trim(tmp_name_iom) 1040 CALL iom_put( trim(tmp_name_iom), zrmet_out ) 637 1041 zrmet_out(:,:,:) = 0 1042 zrmet_val = 0 1043 tmp_name_iom = '' 638 1044 ELSE 639 1045 … … 646 1052 647 1053 DO jm = 1,9 648 CALL iom_put( "reg_" // trim(name) // '_ave', dummy_zrmet )649 CALL iom_put( "reg_" // trim(name) // '_tot', dummy_zrmet )650 CALL iom_put( "reg_" // trim(name) // '_var', dummy_zrmet )651 CALL iom_put( "reg_" // trim(name) // '_cnt', dummy_zrmet )652 CALL iom_put( "reg_" // trim(name) // '_reg_id', dummy_zrmet )653 CALL iom_put( "reg_" // trim(name) // '_mask_id', dummy_zrmet )1054 CALL iom_put( trim(trim("reg_") // trim(tmp_name) // trim('_ave')), dummy_zrmet ) 1055 CALL iom_put( trim(trim("reg_") // trim(tmp_name) // trim('_tot')), dummy_zrmet ) 1056 CALL iom_put( trim(trim("reg_") // trim(tmp_name) // trim('_var')), dummy_zrmet ) 1057 CALL iom_put( trim(trim("reg_") // trim(tmp_name) // trim('_cnt')), dummy_zrmet ) 1058 CALL iom_put( trim(trim("reg_") // trim(tmp_name) // trim('_reg_id')), dummy_zrmet ) 1059 CALL iom_put( trim(trim("reg_") // trim(tmp_name) // trim('_mask_id')), dummy_zrmet ) 654 1060 END DO 655 1061 … … 657 1063 ENDIF 658 1064 659 DEALLOCATE(zrmet_ave,zrmet_tot,zrmet_var,zrmet_cnt,zrmet_mask_id,zrmet_reg_id,zrmet_out) 1065 DEALLOCATE(zrmet_ave,zrmet_tot,zrmet_var,zrmet_cnt,zrmet_mask_id,zrmet_reg_id,zrmet_min,zrmet_max,zrmet_out) 1066 1067 IF(lwp .AND. verbose) THEN ! Control print 1068 WRITE(numout,*) 1069 WRITE(numout,*) 'dia_wri_region_mean finished for ', trim(tmp_name) 1070 WRITE(numout,*) 1071 CALL FLUSH(numout) 1072 ENDIF 1073 660 1074 END SUBROUTINE dia_wri_region_mean 661 1075 -
branches/UKMO/CO6_shelfclimate_fabm/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90
r7567 r8672 11 11 USE iom ! I/0 library 12 12 USE wrk_nemo ! working arrays 13 USE diaregmean 14 15 #if defined key_fabm 16 USE trc 17 USE par_fabm 18 #endif 13 19 14 20 … … 131 137 !!-------------------------------------------------------------------- 132 138 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmb ! temporary workspace 133 REAL(wp) :: zmdi ! set masked values 134 139 REAL(wp) :: zmdi ! set masked values 140 INTEGER :: jn ! set masked values 141 #if defined key_fabm 142 INTEGER :: tmp_dummy 143 #endif 135 144 zmdi=1.e+20 !missing data indicator for maskin 136 145 … … 166 175 CALL iom_put( "bot_v" , zwtmb(:,:,3) ) ! tmb V Velocity 167 176 CALL iom_put( "dif_v" , (zwtmb(:,:,1) - zwtmb(:,:,3))*tmask(:,:,1)+zmdi*(1.0-tmask(:,:,1 ) ) ) ! tmb V Velocity 177 178 CALL wrk_alloc( jpi , jpj, 3 , zwtmb ) 179 180 #if defined key_fabm 181 CALL wrk_alloc( jpi , jpj, 6 , zwtmb ) 182 DO jn=1,jp_fabm ! State loop 183 184 ! By default, only use a small sub sample of values. 185 tmp_dummy = 0 186 SELECT CASE (trim(ctrcnm(jn))) 187 CASE ('N1_p') ; tmp_dummy = 0 188 CASE ('N3_n') ; tmp_dummy = 0 189 CASE ('N4_n') ; tmp_dummy = 0 190 CASE ('N5_s') ; tmp_dummy = 0 191 192 CASE ('O2_o') ; tmp_dummy = 0 193 !CASE ('O3_c') ; tmp_dummy = 0 194 !CASE ('O3_bioalk') ; tmp_dummy = 0 195 196 CASE ('P1_Chl') ; tmp_dummy = 0 197 CASE ('P2_Chl') ; tmp_dummy = 0 198 CASE ('P3_Chl') ; tmp_dummy = 0 199 CASE ('P4_Chl') ; tmp_dummy = 0 200 201 CASE ('P1_c') ; tmp_dummy = 0 202 CASE ('P2_c') ; tmp_dummy = 0 203 CASE ('P3_c') ; tmp_dummy = 0 204 CASE ('P4_c') ; tmp_dummy = 0 205 206 CASE ('Z4_c') ; tmp_dummy = 0 207 CASE ('Z5_c') ; tmp_dummy = 0 208 CASE ('Z6_c') ; tmp_dummy = 0 209 CASE DEFAULT 210 tmp_dummy = 1 211 CYCLE 212 END SELECT 213 214 CALL dia_calctmb_region_mean( trn(:,:,:,jn),zwtmb ) 215 CALL iom_put( "top_"//TRIM(ctrcnm(jn)), zwtmb(:,:,1) ) ! tmb Temperature 216 CALL iom_put( "bot_"//TRIM(ctrcnm(jn)), zwtmb(:,:,2) ) ! tmb Temperature 217 CALL iom_put( "dif_"//TRIM(ctrcnm(jn)), zwtmb(:,:,3) ) ! tmb Temperature 218 CALL iom_put( "zav_"//TRIM(ctrcnm(jn)), zwtmb(:,:,4) ) ! tmb Temperature 219 CALL iom_put( "vol_"//TRIM(ctrcnm(jn)), zwtmb(:,:,5) ) ! tmb Temperature 220 221 222 223 !CALL dia_calctmb( trn(:,:,:,jn),zwtmb ) 224 !CALL iom_put( "top_"//TRIM(ctrcnm(jn)), zwtmb(:,:,1) ) ! tmb Temperature 225 !CALL iom_put( "mid_"//TRIM(ctrcnm(jn)), zwtmb(:,:,2) ) ! tmb Temperature 226 !CALL iom_put( "bot_"//TRIM(ctrcnm(jn)), zwtmb(:,:,3) ) ! tmb Temperature 227 !CALL iom_put( "dif_"//TRIM(ctrcnm(jn)), (zwtmb(:,:,1) - zwtmb(:,:,3))*tmask(:,:,1)+zmdi*(1.0-tmask(:,:,1 ) ) ) ! tmb Temperature 228 ENDDO ! State loop 229 CALL wrk_dealloc( jpi , jpj, 6 , zwtmb ) 230 #endif 168 231 169 232 !Called in dynspg_ts.F90 CALL iom_put( "baro_v" , vn_b ) ! Barotropic V Velocity -
branches/UKMO/CO6_shelfclimate_fabm/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r7593 r8672 133 133 LOGICAL :: ln_diaregmean_diasbc ! region mean calculation including Surface BC 134 134 135 #if defined key_fabm 136 LOGICAL :: ln_diaregmean_bgc ! region mean calculation including BGC 137 #endif 135 138 ! Read the number region mask to work out how many regions are needed. 136 139 140 #if defined key_fabm 141 NAMELIST/nam_diaregmean/ ln_diaregmean,ln_diaregmean_ascii,ln_diaregmean_bin,ln_diaregmean_nc,& 142 & ln_diaregmean_karamld, ln_diaregmean_pea,ln_diaregmean_diaar5,ln_diaregmean_diasbc,ln_diaregmean_bgc 143 #else 137 144 NAMELIST/nam_diaregmean/ ln_diaregmean,ln_diaregmean_ascii,ln_diaregmean_bin,ln_diaregmean_nc,& 138 145 & ln_diaregmean_karamld, ln_diaregmean_pea,ln_diaregmean_diaar5,ln_diaregmean_diasbc 139 146 #endif 140 147 141 148 ! read in Namelist.
Note: See TracChangeset
for help on using the changeset viewer.
