- Timestamp:
- 2017-06-21T16:27:21+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r7203 r8201 27 27 USE trcnam_trp 28 28 USE iom 29 USE ioipsl, ONLY : ju2ymds ! for calendar 29 30 USE daymod 31 !! AXY (05/11/13): need these for MEDUSA to input/output benthic reservoirs 32 USE sms_medusa 33 USE trcsms_medusa 34 !! 35 #if defined key_idtra 36 USE trcsms_idtra 37 #endif 38 !! 39 #if defined key_cfc 40 USE trcsms_cfc 41 #endif 42 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 43 USE sbc_oce, ONLY: lk_oasis 44 USE oce, ONLY: CO2Flux_out_cpl, DMS_out_cpl, chloro_out_cpl !! Coupling variable 45 30 46 IMPLICIT NONE 31 47 PRIVATE … … 35 51 PUBLIC trc_rst_wri ! called by ??? 36 52 PUBLIC trc_rst_cal 53 PUBLIC trc_rst_stat 54 PUBLIC trc_rst_dia_stat 55 PUBLIC trc_rst_tra_stat 37 56 38 57 !! * Substitutions … … 48 67 !!---------------------------------------------------------------------- 49 68 INTEGER, INTENT(in) :: kt ! number of iteration 69 INTEGER :: iyear, imonth, iday 70 REAL (wp) :: zsec 71 REAL (wp) :: zfjulday 50 72 ! 51 73 CHARACTER(LEN=20) :: clkt ! ocean time-step define as a character … … 78 100 ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1 79 101 IF( kt == nitrst - 2*nn_dttrc .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN 80 ! beware of the format used to write kt (default is i8.8, that should be large enough) 81 IF( nitrst > 1.0e9 ) THEN ; WRITE(clkt,* ) nitrst 82 ELSE ; WRITE(clkt,'(i8.8)') nitrst 102 IF ( ln_rstdate ) THEN 103 !! JPALM -- 22-12-2015 -- modif to get the good date on restart trc file name 104 !! -- the condition to open the rst file is not the same than for the dynamic rst. 105 !! -- here it - for an obscure reason - is open 2 time-step before the restart writing process 106 !! instead of 1. 107 !! -- i am not sure if someone forgot +1 in the if loop condition as 108 !! it is writen in all comments nitrst -2*nn_dttrc + 1 and the condition is 109 !! nitrst - 2*nn_dttrc 110 !! -- nevertheless we didn't wanted to broke something already working 111 !! and just adapted the part we added. 112 !! -- So instead of calling ju2ymds( fjulday + (rdttra(1)) 113 !! we call ju2ymds( fjulday + (2*rdttra(1)) 114 !!-------------------------------------------------------------------- 115 zfjulday = fjulday + (2*rdttra(1)) / rday 116 IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday ) zfjulday = REAL(NINT(zfjulday),wp) ! avoid truncation error 117 CALL ju2ymds( zfjulday + (2*rdttra(1)) / rday, iyear, imonth, iday, zsec ) 118 WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday 119 ELSE 120 ! beware of the format used to write kt (default is i8.8, that should be large enough) 121 IF( nitrst > 1.0e9 ) THEN ; WRITE(clkt,* ) nitrst 122 ELSE ; WRITE(clkt,'(i8.8)') nitrst 123 ENDIF 83 124 ENDIF 84 125 ! create the file … … 101 142 !! ** purpose : read passive tracer fields in restart files 102 143 !!---------------------------------------------------------------------- 103 INTEGER :: jn 144 INTEGER :: jn, jl 145 !! AXY (05/11/13): temporary variables 146 REAL(wp) :: fq0,fq1,fq2 104 147 105 148 !!---------------------------------------------------------------------- … … 112 155 DO jn = 1, jptra 113 156 CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 157 trn(:,:,:,jn) = trn(:,:,:,jn) * tmask(:,:,:) 114 158 END DO 115 159 116 160 DO jn = 1, jptra 117 161 CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 118 END DO 162 trb(:,:,:,jn) = trb(:,:,:,jn) * tmask(:,:,:) 163 END DO 164 ! 165 !! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent 166 !! call to MEDUSA-2 at this point; this suggests that the FCM 167 !! version of NEMO date significantly earlier than the current 168 !! version 169 170 #if defined key_medusa 171 !! AXY (13/01/12): check if the restart contains sediment fields; 172 !! this is only relevant for simulations that include 173 !! biogeochemistry and are restarted from earlier runs 174 !! in which there was no sediment component 175 !! 176 IF( iom_varid( numrtr, 'B_SED_N', ldstop = .FALSE. ) > 0 ) THEN 177 !! YES; in which case read them 178 !! 179 IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields present - reading in ...' 180 CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_N', zb_sed_n(:,:) ) 181 CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_N', zn_sed_n(:,:) ) 182 CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_FE', zb_sed_fe(:,:) ) 183 CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_FE', zn_sed_fe(:,:) ) 184 CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_SI', zb_sed_si(:,:) ) 185 CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_SI', zn_sed_si(:,:) ) 186 CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_C', zb_sed_c(:,:) ) 187 CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_C', zn_sed_c(:,:) ) 188 CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_CA', zb_sed_ca(:,:) ) 189 CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_CA', zn_sed_ca(:,:) ) 190 ELSE 191 !! NO; in which case set them to zero 192 !! 193 IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields absent - setting to zero ...' 194 zb_sed_n(:,:) = 0.0 !! organic N 195 zn_sed_n(:,:) = 0.0 196 zb_sed_fe(:,:) = 0.0 !! organic Fe 197 zn_sed_fe(:,:) = 0.0 198 zb_sed_si(:,:) = 0.0 !! inorganic Si 199 zn_sed_si(:,:) = 0.0 200 zb_sed_c(:,:) = 0.0 !! organic C 201 zn_sed_c(:,:) = 0.0 202 zb_sed_ca(:,:) = 0.0 !! inorganic C 203 zn_sed_ca(:,:) = 0.0 204 ENDIF 205 !! 206 !! calculate stats on these fields 207 IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...' 208 call trc_rst_dia_stat(zn_sed_n(:,:), 'Sediment N') 209 call trc_rst_dia_stat(zn_sed_fe(:,:), 'Sediment Fe') 210 call trc_rst_dia_stat(zn_sed_si(:,:), 'Sediment Si') 211 call trc_rst_dia_stat(zn_sed_c(:,:), 'Sediment C') 212 call trc_rst_dia_stat(zn_sed_ca(:,:), 'Sediment Ca') 213 !! 214 !! AXY (07/07/15): read in temporally averaged fields for DMS 215 !! calculations 216 !! 217 IF( iom_varid( numrtr, 'B_DMS_CHN', ldstop = .FALSE. ) > 0 ) THEN 218 !! YES; in which case read them 219 !! 220 IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS present - reading in ...' 221 CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_CHN', zb_dms_chn(:,:) ) 222 CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_CHN', zn_dms_chn(:,:) ) 223 CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_CHD', zb_dms_chd(:,:) ) 224 CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_CHD', zn_dms_chd(:,:) ) 225 CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_MLD', zb_dms_mld(:,:) ) 226 CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_MLD', zn_dms_mld(:,:) ) 227 CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_QSR', zb_dms_qsr(:,:) ) 228 CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_QSR', zn_dms_qsr(:,:) ) 229 CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_DIN', zb_dms_din(:,:) ) 230 CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_DIN', zn_dms_din(:,:) ) 231 ELSE 232 !! NO; in which case set them to zero 233 !! 234 IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS absent - setting to zero ...' 235 zb_dms_chn(:,:) = 0.0 !! CHN 236 zn_dms_chn(:,:) = 0.0 237 zb_dms_chd(:,:) = 0.0 !! CHD 238 zn_dms_chd(:,:) = 0.0 239 zb_dms_mld(:,:) = 0.0 !! MLD 240 zn_dms_mld(:,:) = 0.0 241 zb_dms_qsr(:,:) = 0.0 !! QSR 242 zn_dms_qsr(:,:) = 0.0 243 zb_dms_din(:,:) = 0.0 !! DIN 244 zn_dms_din(:,:) = 0.0 245 ENDIF 246 !! 247 !! JPALM 14-06-2016 -- add CO2 flux and DMS surf through the restart 248 !! -- needed for the coupling with atm 249 IF( iom_varid( numrtr, 'N_DMS_srf', ldstop = .FALSE. ) > 0 ) THEN 250 IF(lwp) WRITE(numout,*) 'DMS surf concentration - reading in ...' 251 CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_srf', zb_dms_srf(:,:) ) 252 CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_srf', zn_dms_srf(:,:) ) 253 ELSE 254 IF(lwp) WRITE(numout,*) 'DMS surf concentration - setting to zero ...' 255 zb_dms_srf(:,:) = 0.0 !! DMS 256 zn_dms_srf(:,:) = 0.0 257 ENDIF 258 IF (lk_oasis) THEN 259 DMS_out_cpl(:,:) = zn_dms_srf(:,:) !! Coupling variable 260 END IF 261 !! 262 IF( iom_varid( numrtr, 'B_CO2_flx', ldstop = .FALSE. ) > 0 ) THEN 263 IF(lwp) WRITE(numout,*) 'CO2 air-sea flux - reading in ...' 264 CALL iom_get( numrtr, jpdom_autoglo, 'B_CO2_flx', zb_co2_flx(:,:) ) 265 CALL iom_get( numrtr, jpdom_autoglo, 'N_CO2_flx', zn_co2_flx(:,:) ) 266 ELSE 267 IF(lwp) WRITE(numout,*) 'CO2 air-sea flux - setting to zero ...' 268 zb_co2_flx(:,:) = 0.0 !! CO2 flx 269 zn_co2_flx(:,:) = 0.0 270 ENDIF 271 IF (lk_oasis) THEN 272 CO2Flux_out_cpl(:,:) = zn_co2_flx(:,:) !! Coupling variable 273 END IF 274 !! 275 !! JPALM 02-06-2017 -- in complement to DMS surf 276 !! -- the atm model needs surf Chl 277 !! as proxy of org matter from the ocean 278 !! -- needed for the coupling with atm 279 IF( iom_varid( numrtr, 'N_CHL_srf', ldstop = .FALSE. ) > 0 ) THEN 280 IF(lwp) WRITE(numout,*) 'Chl surf concentration - reading in ...' 281 CALL iom_get( numrtr, jpdom_autoglo, 'N_CHL_srf', zn_chl_srf(:,:) ) 282 ELSE 283 IF(lwp) WRITE(numout,*) 'Chl surf concentration - setting to zero ...' 284 zn_chl_srf(:,:) = (trn(:,:,1,jpchn) + trn(:,:,1,jpchd)) * 1.E-6 285 ENDIF 286 IF (lk_oasis) THEN 287 chloro_out_cpl(:,:) = zn_chl_srf(:,:) !! Coupling variable 288 END IF 289 !! 290 !! calculate stats on these fields 291 IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...' 292 call trc_rst_dia_stat(zn_dms_chn(:,:), 'DMS, CHN') 293 call trc_rst_dia_stat(zn_dms_chd(:,:), 'DMS, CHD') 294 call trc_rst_dia_stat(zn_dms_mld(:,:), 'DMS, MLD') 295 call trc_rst_dia_stat(zn_dms_qsr(:,:), 'DMS, QSR') 296 call trc_rst_dia_stat(zn_dms_din(:,:), 'DMS, DIN') 297 call trc_rst_dia_stat(zn_dms_srf(:,:), 'DMS surf') 298 call trc_rst_dia_stat(zn_co2_flx(:,:), 'CO2 flux') 299 call trc_rst_dia_stat(zn_chl_srf(:,:), 'CHL surf') 300 !! 301 !! JPALM 14-06-2016 -- add Carbonate chenistry variables through the restart 302 !! -- needed for monthly call of carb-chem routine and better reproducibility 303 # if defined key_roam 304 IF( iom_varid( numrtr, 'pH_3D', ldstop = .FALSE. ) > 0 ) THEN 305 IF(lwp) WRITE(numout,*) 'Carbonate chem variable - reading in ...' 306 CALL iom_get( numrtr, jpdom_autoglo, 'pH_3D' , f3_pH(:,:,:) ) 307 CALL iom_get( numrtr, jpdom_autoglo, 'h2CO3_3D', f3_h2co3(:,:,:) ) 308 CALL iom_get( numrtr, jpdom_autoglo, 'hCO3_3D' , f3_hco3(:,:,:) ) 309 CALL iom_get( numrtr, jpdom_autoglo, 'CO3_3D' , f3_co3(:,:,:) ) 310 CALL iom_get( numrtr, jpdom_autoglo, 'omcal_3D', f3_omcal(:,:,:) ) 311 CALL iom_get( numrtr, jpdom_autoglo, 'omarg_3D', f3_omarg(:,:,:) ) 312 CALL iom_get( numrtr, jpdom_autoglo, 'CCD_CAL' , f2_ccd_cal(:,:) ) 313 CALL iom_get( numrtr, jpdom_autoglo, 'CCD_ARG' , f2_ccd_arg(:,:) ) 314 !! 315 IF(lwp) WRITE(numout,*) ' MEDUSA averaged Carb-chem stats (min, max, sum) ...' 316 call trc_rst_dia_stat( f3_pH(:,:,1) ,'pH 3D surf') 317 call trc_rst_dia_stat( f3_h2co3(:,:,1),'h2CO3 3D surf') 318 call trc_rst_dia_stat( f3_hco3(:,:,1) ,'hCO3 3D surf' ) 319 call trc_rst_dia_stat( f3_co3(:,:,1) ,'CO3 3D surf' ) 320 call trc_rst_dia_stat( f3_omcal(:,:,1),'omcal 3D surf') 321 call trc_rst_dia_stat( f3_omarg(:,:,1),'omarg 3D surf') 322 call trc_rst_dia_stat( f2_ccd_cal(:,:),'CCD_CAL') 323 call trc_rst_dia_stat( f2_ccd_arg(:,:),'CCD_ARG') 324 325 ELSE 326 IF(lwp) WRITE(numout,*) 'WARNING : No Carbonate-chem variable in the restart.... ' 327 IF(lwp) WRITE(numout,*) 'Is not a problem if start a month, but may be very problematic if not ' 328 IF(lwp) WRITE(numout,*) 'Check if mod(kt*rdt,2592000) == rdt' 329 IF(lwp) WRITE(numout,*) 'Or don t start from uncomplete restart...' 330 ENDIF 331 # endif 332 333 334 #endif 335 ! 336 #if defined key_idtra 337 !! JPALM -- 05-01-2016 -- mv idtra and CFC restart reading and 338 !! writting here undre their key. 339 !! problems in CFC restart, maybe because of this... 340 !! and pb in idtra diag or diad-restart writing. 341 !!---------------------------------------------------------------------- 342 IF( iom_varid( numrtr, 'qint_IDTRA', ldstop = .FALSE. ) > 0 ) THEN 343 !! YES; in which case read them 344 !! 345 IF(lwp) WRITE(numout,*) ' IDTRA averaged properties present - reading in ...' 346 CALL iom_get( numrtr, jpdom_autoglo, 'qint_IDTRA', qint_idtra(:,:,1) ) 347 ELSE 348 !! NO; in which case set them to zero 349 !! 350 IF(lwp) WRITE(numout,*) ' IDTRA averaged properties absent - setting to zero ...' 351 qint_idtra(:,:,1) = 0.0 !! CHN 352 ENDIF 353 !! 354 !! calculate stats on these fields 355 IF(lwp) WRITE(numout,*) ' IDTRA averaged properties stats (min, max, sum) ...' 356 call trc_rst_dia_stat(qint_idtra(:,:,1), 'qint_IDTRA') 357 #endif 358 ! 359 #if defined key_cfc 360 DO jl = 1, jp_cfc 361 jn = jp_cfc0 + jl - 1 362 IF( iom_varid( numrtr, 'qint_'//ctrcnm(jn), ldstop = .FALSE. ) > 0 ) THEN 363 !! YES; in which case read them 364 !! 365 IF(lwp) WRITE(numout,*) ' CFC averaged properties present - reading in ...' 366 CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) ) 367 ELSE 368 !! NO; in which case set them to zero 369 !! 370 IF(lwp) WRITE(numout,*) ' CFC averaged properties absent - setting to zero ...' 371 qint_cfc(:,:,jn) = 0.0 !! CHN 372 ENDIF 373 !! 374 !! calculate stats on these fields 375 IF(lwp) WRITE(numout,*) ' CFC averaged properties stats (min, max, sum) ...' 376 call trc_rst_dia_stat(qint_cfc(:,:,jl), 'qint_'//ctrcnm(jn)) 377 END DO 378 #endif 119 379 ! 120 380 END SUBROUTINE trc_rst_read … … 128 388 INTEGER, INTENT( in ) :: kt ! ocean time-step index 129 389 !! 130 INTEGER :: jn 390 INTEGER :: jn, jl 131 391 REAL(wp) :: zarak0 392 !! AXY (05/11/13): temporary variables 393 REAL(wp) :: fq0,fq1,fq2 132 394 !!---------------------------------------------------------------------- 133 395 ! … … 142 404 CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 143 405 END DO 144 ! 406 407 !! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent 408 !! call to MEDUSA-2 at this point; this suggests that the FCM 409 !! version of NEMO date significantly earlier than the current 410 !! version 411 412 #if defined key_medusa 413 !! AXY (13/01/12): write out "before" and "now" state of seafloor 414 !! sediment pools into restart; this happens 415 !! whether or not the pools are to be used by 416 !! MEDUSA (which is controlled by a switch in the 417 !! namelist_top file) 418 !! 419 IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields - writing out ...' 420 CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_N', zb_sed_n(:,:) ) 421 CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_N', zn_sed_n(:,:) ) 422 CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_FE', zb_sed_fe(:,:) ) 423 CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_FE', zn_sed_fe(:,:) ) 424 CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_SI', zb_sed_si(:,:) ) 425 CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_SI', zn_sed_si(:,:) ) 426 CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_C', zb_sed_c(:,:) ) 427 CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_C', zn_sed_c(:,:) ) 428 CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_CA', zb_sed_ca(:,:) ) 429 CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_CA', zn_sed_ca(:,:) ) 430 !! 431 !! calculate stats on these fields 432 IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...' 433 call trc_rst_dia_stat(zn_sed_n(:,:), 'Sediment N') 434 call trc_rst_dia_stat(zn_sed_fe(:,:), 'Sediment Fe') 435 call trc_rst_dia_stat(zn_sed_si(:,:), 'Sediment Si') 436 call trc_rst_dia_stat(zn_sed_c(:,:), 'Sediment C') 437 call trc_rst_dia_stat(zn_sed_ca(:,:), 'Sediment Ca') 438 !! 439 !! AXY (07/07/15): write out temporally averaged fields for DMS 440 !! calculations 441 !! 442 IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS - writing out ...' 443 CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHN', zb_dms_chn(:,:) ) 444 CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHN', zn_dms_chn(:,:) ) 445 CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHD', zb_dms_chd(:,:) ) 446 CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHD', zn_dms_chd(:,:) ) 447 CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_MLD', zb_dms_mld(:,:) ) 448 CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_MLD', zn_dms_mld(:,:) ) 449 CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_QSR', zb_dms_qsr(:,:) ) 450 CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_QSR', zn_dms_qsr(:,:) ) 451 CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_DIN', zb_dms_din(:,:) ) 452 CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_DIN', zn_dms_din(:,:) ) 453 !! JPALM 14-06-2016 -- add CO2 flux and DMS surf through the restart 454 !! -- needed for the coupling with atm 455 CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_srf', zb_dms_srf(:,:) ) 456 CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_srf', zn_dms_srf(:,:) ) 457 CALL iom_rstput( kt, nitrst, numrtw, 'B_CO2_flx', zb_co2_flx(:,:) ) 458 CALL iom_rstput( kt, nitrst, numrtw, 'N_CO2_flx', zn_co2_flx(:,:) ) 459 CALL iom_rstput( kt, nitrst, numrtw, 'N_CHL_srf', zn_chl_srf(:,:) ) 460 !! 461 !! calculate stats on these fields 462 IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...' 463 call trc_rst_dia_stat(zn_dms_chn(:,:), 'DMS, CHN') 464 call trc_rst_dia_stat(zn_dms_chd(:,:), 'DMS, CHD') 465 call trc_rst_dia_stat(zn_dms_mld(:,:), 'DMS, MLD') 466 call trc_rst_dia_stat(zn_dms_qsr(:,:), 'DMS, QSR') 467 call trc_rst_dia_stat(zn_dms_din(:,:), 'DMS, DIN') 468 call trc_rst_dia_stat(zn_dms_srf(:,:), 'DMS surf') 469 call trc_rst_dia_stat(zn_co2_flx(:,:), 'CO2 flux') 470 call trc_rst_dia_stat(zn_chl_srf(:,:), 'CHL surf') 471 !! 472 IF(lwp) WRITE(numout,*) ' MEDUSA averaged prop. for dust and iron dep.' 473 call trc_rst_dia_stat(dust(:,:), 'Dust dep') 474 call trc_rst_dia_stat(zirondep(:,:), 'Iron dep') 475 !! 476 !! 477 !! JPALM 14-06-2016 -- add Carbonate chenistry variables through the restart 478 !! -- needed for monthly call of carb-chem routine and better reproducibility 479 # if defined key_roam 480 IF(lwp) WRITE(numout,*) 'Carbonate chem variable - writing out ...' 481 CALL iom_rstput( kt, nitrst, numrtw, 'pH_3D' , f3_pH(:,:,:) ) 482 CALL iom_rstput( kt, nitrst, numrtw, 'h2CO3_3D', f3_h2co3(:,:,:) ) 483 CALL iom_rstput( kt, nitrst, numrtw, 'hCO3_3D' , f3_hco3(:,:,:) ) 484 CALL iom_rstput( kt, nitrst, numrtw, 'CO3_3D' , f3_co3(:,:,:) ) 485 CALL iom_rstput( kt, nitrst, numrtw, 'omcal_3D', f3_omcal(:,:,:) ) 486 CALL iom_rstput( kt, nitrst, numrtw, 'omarg_3D', f3_omarg(:,:,:) ) 487 CALL iom_rstput( kt, nitrst, numrtw, 'CCD_CAL' , f2_ccd_cal(:,:) ) 488 CALL iom_rstput( kt, nitrst, numrtw, 'CCD_ARG' , f2_ccd_arg(:,:) ) 489 !! 490 IF(lwp) WRITE(numout,*) ' MEDUSA averaged Carb-chem stats (min, max, sum) ...' 491 call trc_rst_dia_stat( f3_pH(:,:,1) ,'pH 3D surf') 492 call trc_rst_dia_stat( f3_h2co3(:,:,1),'h2CO3 3D surf') 493 call trc_rst_dia_stat( f3_hco3(:,:,1) ,'hCO3 3D surf' ) 494 call trc_rst_dia_stat( f3_co3(:,:,1) ,'CO3 3D surf' ) 495 call trc_rst_dia_stat( f3_omcal(:,:,1),'omcal 3D surf') 496 call trc_rst_dia_stat( f3_omarg(:,:,1),'omarg 3D surf') 497 call trc_rst_dia_stat( f2_ccd_cal(:,:),'CCD_CAL') 498 call trc_rst_dia_stat( f2_ccd_arg(:,:),'CCD_ARG') 499 !! 500 # endif 501 !! 502 #endif 503 ! 504 #if defined key_idtra 505 !! JPALM -- 05-01-2016 -- mv idtra and CFC restart reading and 506 !! writting here undre their key. 507 !! problems in CFC restart, maybe because of this... 508 !! and pb in idtra diag or diad-restart writing. 509 !!---------------------------------------------------------------------- 510 IF(lwp) WRITE(numout,*) ' IDTRA averaged properties - writing out ...' 511 CALL iom_rstput( kt, nitrst, numrtw, 'qint_IDTRA', qint_idtra(:,:,1) ) 512 !! 513 !! calculate stats on these fields 514 IF(lwp) WRITE(numout,*) ' IDTRA averaged properties stats (min, max, sum) ...' 515 call trc_rst_dia_stat(qint_idtra(:,:,1), 'qint_IDTRA') 516 #endif 517 ! 518 #if defined key_cfc 519 DO jl = 1, jp_cfc 520 jn = jp_cfc0 + jl - 1 521 IF(lwp) WRITE(numout,*) ' CFC averaged properties - writing out ...' 522 CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) ) 523 !! 524 !! calculate stats on these fields 525 IF(lwp) WRITE(numout,*) ' CFC averaged properties stats (min, max, sum) ...' 526 call trc_rst_dia_stat(qint_cfc(:,:,jl), 'qint_'//ctrcnm(jn)) 527 END DO 528 #endif 529 ! 530 145 531 IF( kt == nitrst ) THEN 146 532 CALL trc_rst_stat ! statistics … … 304 690 IF(lwp) WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax, zdrift 305 691 END DO 306 WRITE(numout,*)692 IF(lwp) WRITE(numout,*) 307 693 9000 FORMAT(' tracer nb :',i2,' name :',a10,' mean :',e18.10,' min :',e18.10, & 308 694 & ' max :',e18.10,' drift :',e18.10, ' %') 309 695 ! 310 696 END SUBROUTINE trc_rst_stat 697 698 699 SUBROUTINE trc_rst_tra_stat 700 !!---------------------------------------------------------------------- 701 !! *** trc_rst_tra_stat *** 702 !! 703 !! ** purpose : Compute tracers statistics - check where crazy values appears 704 !!---------------------------------------------------------------------- 705 INTEGER :: jk, jn 706 REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift, areasf 707 REAL(wp), DIMENSION(jpi,jpj) :: zvol 708 !!---------------------------------------------------------------------- 709 710 IF( lwp ) THEN 711 WRITE(numout,*) 712 WRITE(numout,*) ' ----SURFACE TRA STAT---- ' 713 WRITE(numout,*) 714 ENDIF 715 ! 716 zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1) 717 areasf = glob_sum(zvol(:,:)) 718 DO jn = 1, jptra 719 ztraf = glob_sum( tra(:,:,1,jn) * zvol(:,:) ) 720 zmin = MINVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) ) 721 zmax = MAXVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) ) 722 IF( lk_mpp ) THEN 723 CALL mpp_min( zmin ) ! min over the global domain 724 CALL mpp_max( zmax ) ! max over the global domain 725 END IF 726 zmean = ztraf / areasf 727 IF(lwp) WRITE(numout,9001) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax 728 END DO 729 IF(lwp) WRITE(numout,*) 730 9001 FORMAT(' tracer nb :',i2,' name :',a10,' mean :',e18.10,' min :',e18.10, & 731 & ' max :',e18.10) 732 ! 733 END SUBROUTINE trc_rst_tra_stat 734 735 736 737 SUBROUTINE trc_rst_dia_stat( dgtr, names) 738 !!---------------------------------------------------------------------- 739 !! *** trc_rst_dia_stat *** 740 !! 741 !! ** purpose : Compute tracers statistics 742 !!---------------------------------------------------------------------- 743 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: dgtr ! 2D diag var 744 CHARACTER(len=*) , INTENT(in) :: names ! 2D diag name 745 !!--------------------------------------------------------------------- 746 INTEGER :: jk, jn 747 REAL(wp) :: ztraf, zmin, zmax, zmean, areasf 748 REAL(wp), DIMENSION(jpi,jpj) :: zvol 749 !!---------------------------------------------------------------------- 750 751 IF( lwp ) WRITE(numout,*) 'STAT- ', names 752 ! 753 zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1) 754 ztraf = glob_sum( dgtr(:,:) * zvol(:,:) ) 755 !! areasf = glob_sum(e1e2t(:,:) * tmask(:,:,1) ) 756 areasf = glob_sum(zvol(:,:)) 757 zmin = MINVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) ) 758 zmax = MAXVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) ) 759 IF( lk_mpp ) THEN 760 CALL mpp_min( zmin ) ! min over the global domain 761 CALL mpp_max( zmax ) ! max over the global domain 762 END IF 763 zmean = ztraf / areasf 764 IF(lwp) WRITE(numout,9002) TRIM( names ), zmean, zmin, zmax 765 ! 766 IF(lwp) WRITE(numout,*) 767 9002 FORMAT(' tracer name :',a10,' mean :',e18.10,' min :',e18.10, & 768 & ' max :',e18.10 ) 769 ! 770 END SUBROUTINE trc_rst_dia_stat 771 311 772 312 773 #else
Note: See TracChangeset
for help on using the changeset viewer.