Changeset 9073 for branches/NERC
- Timestamp:
- 2017-12-15T12:48:47+01:00 (7 years ago)
- Location:
- branches/NERC/dev_r5518_GO6_Carb_Fail_from_GO6_8356/NEMOGCM/NEMO
- Files:
-
- 1 added
- 6 edited
-
OPA_SRC/stpctl.F90 (modified) (2 diffs)
-
TOP_SRC/MEDUSA/air_sea.F90 (modified) (6 diffs)
-
TOP_SRC/MEDUSA/bio_medusa_init.F90 (modified) (1 diff)
-
TOP_SRC/MEDUSA/trcbio_medusa.F90 (modified) (10 diffs)
-
TOP_SRC/trcrst.F90 (modified) (3 diffs)
-
TOP_SRC/trcstat.F90 (added)
-
TOP_SRC/trcstp.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5518_GO6_Carb_Fail_from_GO6_8356/NEMOGCM/NEMO/OPA_SRC/stpctl.F90
r6487 r9073 58 58 INTEGER :: ii, ij, ik ! temporary integers 59 59 REAL(wp) :: zumax, zsmin, zssh2 ! temporary scalars 60 REAL(wp) :: ztmax, ztmin ! temporary scalars 60 61 INTEGER, DIMENSION(3) :: ilocu ! 61 62 INTEGER, DIMENSION(2) :: ilocs ! … … 148 149 9500 FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i5) 149 150 151 ! ==================================================================================================== 152 ! ==================================================================================================== 153 ! !AXY (25/10/17) 154 ! !* Test max/min limits of temperature 155 ! ! ---------------------------------- 156 ztmax = -5.e0 ! arbitrary low maximum value 157 ztmin = 100.e0 ! arbitrary high minimum value 158 DO jj = 2, jpjm1 159 DO ji = 1, jpi 160 IF( tmask(ji,jj,1) == 1) THEN 161 ztmax = MAX(ztmax,tsn(ji,jj,1,jp_tem)) ! find local maximum 162 ztmin = MIN(ztmin,tsn(ji,jj,1,jp_tem)) ! find local minimum 163 ENDIF 164 END DO 165 END DO 166 IF( lk_mpp ) CALL mpp_max( ztmax ) ! max over the global domain 167 IF( lk_mpp ) CALL mpp_min( ztmin ) ! min over the global domain 168 ! 169 IF( ztmax > 40.) THEN ! we've got a problem 170 IF (lk_mpp) THEN 171 CALL mpp_maxloc ( tsn(:,:,1,jp_tem),tmask(:,:,1), ztmax, ii,ij ) 172 ELSE 173 ilocs = MAXLOC( tsn(:,:,1,jp_tem), mask = tmask(:,:,1) == 1.e0 ) 174 ii = ilocs(1) + nimpp - 1 175 ij = ilocs(2) + njmpp - 1 176 ENDIF 177 ! 178 IF(lwp) THEN 179 WRITE(numout,*) 'stp_ctl:tracer anomaly: ***** WARNING *****' 180 WRITE(numout,*) 'stp_ctl:tracer anomaly: sea surface temperature > 40C' 181 WRITE(numout,9600) kt, ztmax, ii, ij 182 WRITE(numout,*) 'stp_ctl:tracer anomaly: ***** END OF WARNING *****' 183 ENDIF 184 ENDIF 185 ! 186 IF( ztmin < -3.) THEN ! we've got a problem 187 IF (lk_mpp) THEN 188 CALL mpp_minloc ( tsn(:,:,1,jp_tem),tmask(:,:,1), ztmin, ii,ij ) 189 ELSE 190 ilocs = MINLOC( tsn(:,:,1,jp_tem), mask = tmask(:,:,1) == 1.e0 ) 191 ii = ilocs(1) + nimpp - 1 192 ij = ilocs(2) + njmpp - 1 193 ENDIF 194 ! 195 IF(lwp) THEN 196 WRITE(numout,*) 'stp_ctl:tracer anomaly: ***** WARNING *****' 197 WRITE(numout,*) 'stp_ctl:tracer anomaly: sea surface temperature < -3C' 198 WRITE(numout,9700) kt, ztmin, ii, ij 199 WRITE(numout,*) 'stp_ctl:tracer anomaly: ***** END OF WARNING *****' 200 ENDIF 201 ENDIF 202 9600 FORMAT ('stp_ctl:tracer anomaly: kt=',i6,' max SST: ',f16.10,', i j: ',2i5) 203 9700 FORMAT ('stp_ctl:tracer anomaly: kt=',i6,' min SST: ',f16.10,', i j: ',2i5) 204 ! ==================================================================================================== 205 ! ==================================================================================================== 150 206 151 207 IF( lk_c1d ) RETURN ! No log file in case of 1D vertical configuration -
branches/NERC/dev_r5518_GO6_Carb_Fail_from_GO6_8356/NEMOGCM/NEMO/TOP_SRC/MEDUSA/air_sea.F90
r9070 r9073 61 61 # endif 62 62 zchd, zchn, zdin, zsil 63 USE dom_oce, ONLY: e3t_0, e3t_n, gphit, tmask 63 USE dom_oce, ONLY: e3t_0, e3t_n, gphit, tmask, mig, mjg 64 64 # if defined key_iomput 65 65 USE iom, ONLY: lk_iomput … … 90 90 USE trcoxy_medusa, ONLY: trc_oxy_medusa 91 91 # endif 92 USE lib_mpp, ONLY: ctl_stop 93 USE trcstat 92 94 93 95 !!* Substitution … … 121 123 122 124 # if defined key_roam 125 !! init 126 f_fco2w(:,:) = 0.0 127 f_fco2atm(:,:) = 0.0 128 f_schmidtco2(:,:) = 0.0 129 f_kwco2(:,:) = 0.0 130 f_co2starair(:,:) = 0.0 131 f_dpco2(:,:) = 0.0 132 f_rhosw(:,:) = 0.0 133 f_K0(:,:) = 0.0 134 !! air pressure (atm); ultimately this will use air 135 !! pressure at the base of the UKESM1 atmosphere 136 !! 137 f_pp0(:,:) = 1.0 138 139 123 140 !!----------------------------------------------------------- 124 141 !! Air-sea gas exchange … … 133 150 DO ji = 2,jpim1 134 151 !! OPEN wet point IF..THEN loop 135 if(tmask(ji,jj,1) == 1) then152 IF (tmask(ji,jj,1) == 1) then 136 153 IF (lk_oasis) THEN 137 154 !! use 2D atm xCO2 from atm coupling 138 155 f_xco2a(ji,jj) = PCO2a_in_cpl(ji,jj) 156 !!! 157 !!! Jpalm test on atm xCO2 158 IF ( (f_xco2a(ji,jj) > 1500 ).OR.(f_xco2a(ji,jj) < 100 ) ) THEN 159 IF(lwp) THEN 160 WRITE(numout,*) ' atm xCO2 = ',f_xco2a(ji,jj), & 161 ' -- ji =', mig(ji),' jj = ', mjg(jj) 162 CALL ctl_stop( 'MEDUSA - Air-Sea :', 'unrealistic atm xCO2 ' ) 163 ENDIF 164 ENDIF 139 165 ENDIF 140 166 !! … … 161 187 'air-sea: carb-chem kt = ', kt 162 188 CALL flush(numout) 189 !! JPALM add carb print: 190 call trc_rst_dia_stat(f_xco2a(:,:), 'f_xco2a') 191 call trc_rst_dia_stat(wndm(:,:), 'wndm') 192 call trc_rst_dia_stat(f_kw660(:,:), 'f_kw660') 193 call trc_rst_dia_stat(ztmp(:,:), 'ztmp') 194 call trc_rst_dia_stat(zsal(:,:), 'zsal') 195 call trc_rst_dia_stat(zalk(:,:), 'zalk') 196 call trc_rst_dia_stat(zdic(:,:), 'zdic') 197 call trc_rst_dia_stat(zsil(:,:), 'zsil') 198 call trc_rst_dia_stat(zpho(:,:), 'zpho') 163 199 # endif 164 200 DO jj = 2,jpjm1 165 201 DO ji = 2,jpim1 166 202 if (tmask(ji,jj,1) == 1) then 167 !! air pressure (atm); ultimately this will use air168 !! pressure at the base of the UKESM1 atmosphere169 !!170 f_pp0(ji,jj) = 1.0171 !!172 !! IF(lwp) WRITE(numout,*) ' MEDUSA ztmp =', ztmp(ji,jj)173 !! IF(lwp) WRITE(numout,*) ' MEDUSA wndm =', wndm(ji,jj)174 !! IF(lwp) WRITE(numout,*) ' MEDUSA fr_i =', fr_i(ji,jj)175 203 !! 176 204 # if defined key_axy_carbchem 177 205 # if defined key_mocsy 206 !! Jpalm -- 12-09-2017 -- add extra check after reccurent 207 !! carbonate failure in the coupled run. 208 !! must be associated to air-sea flux or air xCO2...i 209 !! Check MOCSY inputs 210 IF ( (zsal(ji,jj) > 75.0 ).OR.(zsal(ji,jj) < 0.0 ) .OR. & 211 (ztmp(ji,jj) > 50.0 ).OR.(ztmp(ji,jj) < -20.0 ) .OR. & 212 (zalk(ji,jj) > 35.0E2 ).OR.(zalk(ji,jj) <= 0.0 ) .OR. & 213 (zdic(ji,jj) > 35.0E2 ).OR.(zdic(ji,jj) <= 0.0 ) .OR. & 214 (f_kw660(ji,jj) > 1.0E-2 ).OR.(f_kw660(ji,jj) < 0.0 ) ) THEN 215 IF(lwp) THEN 216 WRITE(numout,*) ' surface T = ',ztmp(ji,jj) 217 WRITE(numout,*) ' surface S = ',zsal(ji,jj) 218 WRITE(numout,*) ' surface ALK = ',zalk(ji,jj) 219 WRITE(numout,*) ' surface DIC = ',zdic(ji,jj) 220 WRITE(numout,*) ' KW660 = ',f_kw660(ji,jj) 221 WRITE(numout,*) ' atm xCO2 = ',f_xco2a(ji,jj) 222 WRITE(numout,*) ' surface pco2w = ',f_pco2w(ji,jj) 223 WRITE(numout,*) ' surface fco2w = ',f_fco2w(ji,jj) 224 WRITE(numout,*) ' surface fco2a = ',f_fco2atm(ji,jj) 225 WRITE(numout,*) ' surface co2flx = ',f_co2flux(ji,jj) 226 WRITE(numout,*) ' surface dpco2 = ',f_dpco2(ji,jj) 227 WRITE(numout,*) ' MOCSY input: ji =', mig(ji),' jj = ', mjg(jj), & 228 ' kt = ', kt 229 WRITE(numout,*) 'MEDUSA - Air-Sea INPUT: unrealistic surface Carb. Chemistry' 230 CALL ctl_stop( 'MEDUSA - Air-Sea INPUT: ', & 231 'unrealistic surface Carb. Chemistry -- INPUTS' ) 232 ENDIF 233 ENDIF 178 234 !! 179 235 !! AXY (22/06/15): use Orr & Epitalon (2015) MOCSY-2 carbonate … … 200 256 f_TALK(ji,jj) = (zalk(ji,jj) / f_rhosw(ji,jj)) * 1000. 201 257 f_dcf(ji,jj) = f_rhosw(ji,jj) 258 !! Jpalm -- 12-09-2017 -- add extra check after reccurent 259 !! carbonate failure in the coupled run. 260 !! must be associated to air-sea flux or air xCO2...i 261 !! Check MOCSY inputs 262 IF ( (f_pco2w(ji,jj) > 1.E4 ).OR.(f_pco2w(ji,jj) < 0.0 ) .OR. & 263 (f_fco2w(ji,jj) > 1.E4 ).OR.(f_fco2w(ji,jj) < 0.0 ) .OR. & 264 (f_fco2atm(ji,jj) > 1.E4 ).OR.(f_fco2atm(ji,jj) < 0.0 ) .OR. & 265 (f_co2flux(ji,jj) > 1.E-2 ).OR.(f_co2flux(ji,jj) < -1.E-2 ) .OR. & 266 (f_dpco2(ji,jj) > 1.E4 ).OR.(f_dpco2(ji,jj) < -1.E4 ) ) THEN 267 IF(lwp) THEN 268 WRITE(numout,*) ' surface T = ',ztmp(ji,jj) 269 WRITE(numout,*) ' surface S = ',zsal(ji,jj) 270 WRITE(numout,*) ' surface ALK = ',zalk(ji,jj) 271 WRITE(numout,*) ' surface DIC = ',zdic(ji,jj) 272 WRITE(numout,*) ' KW660 = ',f_kw660(ji,jj) 273 WRITE(numout,*) ' atm xCO2 = ',f_xco2a(ji,jj) 274 WRITE(numout,*) ' surface pco2w = ',f_pco2w(ji,jj) 275 WRITE(numout,*) ' surface fco2w = ',f_fco2w(ji,jj) 276 WRITE(numout,*) ' surface fco2a = ',f_fco2atm(ji,jj) 277 WRITE(numout,*) ' surface co2flx = ',f_co2flux(ji,jj) 278 WRITE(numout,*) ' surface dpco2 = ',f_dpco2(ji,jj) 279 WRITE(numout,*) ' MOCSY output: ji =', mig(ji),' jj = ', mjg(jj), & 280 ' kt = ', kt 281 WRITE(numout,*) 'MEDUSA - Air-Sea OUTPUT: unrealistic surface Carb. Chemistry' 282 CALL ctl_stop( 'MEDUSA - Air-Sea OUTPUT: ', & 283 'unrealistic surface Carb. Chemistry -- OUTPUTS' ) 284 ENDIF 285 ENDIF 202 286 ENDIF 203 287 ENDDO 204 288 ENDDO 205 289 290 # if defined key_debug_medusa 291 !! JPALM add carb print: 292 call trc_rst_dia_stat(f_pco2w(:,:), 'f_pco2w') 293 call trc_rst_dia_stat(f_fco2w(:,:), 'f_fco2w') 294 call trc_rst_dia_stat(f_fco2atm(:,:), 'f_fco2atm') 295 call trc_rst_dia_stat(f_schmidtco2(:,:), 'f_schmidtco2') 296 call trc_rst_dia_stat(f_kwco2(:,:), 'f_kwco2') 297 call trc_rst_dia_stat(f_co2starair(:,:), 'f_co2starair') 298 call trc_rst_dia_stat(f_co2flux(:,:), 'f_co2flux') 299 call trc_rst_dia_stat(f_dpco2(:,:), 'f_dpco2') 300 # endif 206 301 # else 207 302 -
branches/NERC/dev_r5518_GO6_Carb_Fail_from_GO6_8356/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_init.F90
r9070 r9073 164 164 fslownflux(:,:) = 0.0 165 165 fslowcflux(:,:) = 0.0 166 !! 167 !! JPALM -- 21-09-2017 -- needed to debug air-sea carb 168 f_xco2a(:,:) = 0.0 169 f_pco2w(:,:) = 0.0 170 f_ph(:,:) = 0.0 171 f_kw660(:,:) = 0.0 172 ztmp(:,:) = 0.0 173 zsal(:,:) = 0.0 174 zalk(:,:) = 0.0 175 zdic(:,:) = 0.0 176 zsil(:,:) = 0.0 177 zpho(:,:) = 0.0 178 f_co2flux(:,:) = 0.0 179 f_pco2atm(:,:) = 0.0 180 f_h2co3(:,:) = 0.0 181 f_hco3(:,:) = 0.0 182 f_co3(:,:) = 0.0 183 f_omarg(:,:) = 0.0 184 f_omcal(:,:) = 0.0 185 166 186 !! 167 187 !! allocate and initiate 2D diag -
branches/NERC/dev_r5518_GO6_Carb_Fail_from_GO6_8356/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90
r9070 r9073 23 23 !! - ! 2016-11 (A. Yool) Updated diags for CMIP6 24 24 !! - ! 2017-05 (A. Yool) Added extra DMS calculation 25 !! - ! 2017-11 (J. Palm, A. Yool) Diagnose tracer excursions 25 26 !!---------------------------------------------------------------------- 26 27 !! … … 81 82 gdepw_0, gdepw_n, & 82 83 nday_year, nsec_day, nyear, & 83 rdt, tmask 84 rdt, tmask, mig, mjg, nimpp, & 85 njmpp 84 86 USE in_out_manager, ONLY: lwp, numout, nn_date0 85 87 # if defined key_iomput … … 87 89 # endif 88 90 USE lbclnk, ONLY: lbc_lnk 89 USE lib_mpp , ONLY: ctl_stop91 USE lib_mpp 90 92 USE oce, ONLY: tsb, tsn 91 93 USE par_kind, ONLY: wp … … 115 117 116 118 PUBLIC trc_bio_medusa ! called in trcsms_medusa.F90 119 PUBLIC trc_bio_exceptional_fix ! here 117 120 118 121 !!* Substitution … … 177 180 !! temporary variables 178 181 REAL(wp) :: fq0,fq1,fq2,fq3,fq4 182 !! 183 !! T and S check temporary variable 184 REAL(wp) :: sumtsn, tsnavg 185 INTEGER :: summask 186 CHARACTER(40) :: charout, charout2, charout3, charout4, charout5 179 187 !! 180 188 !!------------------------------------------------------------------ … … 450 458 451 459 # if defined key_roam 460 !! extra MEDUSA-2 tracers 452 461 DO jj = 2,jpjm1 453 462 DO ji = 2,jpim1 … … 456 465 zdtc(ji,jj) = max(0.,trn(ji,jj,jk,jpdtc)) 457 466 !! dissolved inorganic carbon 458 zdic(ji,jj) = max(0.,trn(ji,jj,jk,jpdic))467 zdic(ji,jj) = trn(ji,jj,jk,jpdic) 459 468 !! alkalinity 460 zalk(ji,jj) = max(0.,trn(ji,jj,jk,jpalk))469 zalk(ji,jj) = trn(ji,jj,jk,jpalk) 461 470 !! oxygen 462 471 zoxy(ji,jj) = max(0.,trn(ji,jj,jk,jpoxy)) … … 470 479 ztmp(ji,jj) = tsn(ji,jj,jk,jp_tem) 471 480 zsal(ji,jj) = tsn(ji,jj,jk,jp_sal) 472 !!473 !! AXY (28/02/14): check input fields474 if (ztmp(ji,jj) .lt. -3.0 .or. ztmp(ji,jj) .gt. 40.0 ) then475 IF(lwp) WRITE(numout,*) &476 ' trc_bio_medusa: T WARNING 2D, ', &477 tsb(ji,jj,jk,jp_tem), tsn(ji,jj,jk,jp_tem), &478 ' at (', ji, ',', jj, ',', jk, ') at time', kt479 IF(lwp) WRITE(numout,*) &480 ' trc_bio_medusa: T SWITCHING 2D, ', &481 tsn(ji,jj,jk,jp_tem), ' -> ', tsb(ji,jj,jk,jp_tem)482 !! temperatur483 ztmp(ji,jj) = tsb(ji,jj,jk,jp_tem)484 endif485 if (zsal(ji,jj) .lt. 0.0 .or. zsal(ji,jj) .gt. 45.0 ) then486 IF(lwp) WRITE(numout,*) &487 ' trc_bio_medusa: S WARNING 2D, ', &488 tsb(ji,jj,jk,jp_sal), tsn(ji,jj,jk,jp_sal), &489 ' at (', ji, ',', jj, ',', jk, ') at time', kt490 endif491 481 ENDIF 492 482 ENDDO 493 483 ENDDO 494 484 # else 485 !! diagnostic MEDUSA-1 detrital carbon tracer 495 486 DO jj = 2,jpjm1 496 487 DO ji = 2,jpim1 497 if (tmask(ji,jj,jk) == 1) then488 IF (tmask(ji,jj,jk) == 1) THEN 498 489 !! implicit detrital carbon 499 490 zdtc(ji,jj) = zdet(ji,jj) * xthetad … … 502 493 ENDDO 503 494 # endif 495 496 # if defined key_roam 497 !! --------------------------------------------- 498 !! JPALM -- 14-12-2017 -- Here, before any exeptionnal crazy value is 499 !! removed, we want to tell to the Master Node that this 500 !! Exceptionnal value did exist 501 !! 502 Call trc_bio_check(kt) 503 504 !!================================================================ 505 !! AXY (03/11/17): check input fields 506 !! tracer values that exceed thresholds can cause carbonate system 507 !! failures when passed to MOCSY; temporary temperature excursions 508 !! in recent UKESM0.8 runs trigger such failures but are too short 509 !! to have physical consequences; this section checks for such 510 !! values and amends them using neighbouring values 511 !! 512 !! the check on temperature here is also carried out at the end of 513 !! each model time step and anomalies are reported in the master 514 !! ocean.output file; the error reporting below is strictly local 515 !! to the relevant ocean.output_XXXX file so will not be visible 516 !! unless all nodes are reporting output 517 !!================================================================ 518 !! 519 DO jj = 2,jpjm1 520 DO ji = 2,jpim1 521 if (tmask(ji,jj,jk) == 1) then 522 !! the thresholds for the four tracers are ... 523 IF ( (ztmp(ji,jj) .LT. -3.0) .OR. (ztmp(ji,jj) .GT. 40.0 ) .OR. & 524 (zsal(ji,jj) .LE. 0.0) .OR. (zsal(ji,jj) .GT. 50.0 ) .OR. & 525 (zdic(ji,jj) .LE. 0.0) .OR. (zdic(ji,jj) .GT. 4.0E3 ) .OR. & 526 (zalk(ji,jj) .LE. 0.0) .OR. (zalk(ji,jj) .GT. 4.0E3 ) ) THEN 527 !! 528 !! all tracer values are reported in the event of any excursion 529 write(charout,*) ' Tmp = ', ztmp(ji,jj) 530 write(charout2,*) ' Sal = ', zsal(ji,jj) 531 write(charout3,*) ' DIC = ', zdic(ji,jj) 532 write(charout4,*) ' Alk = ', zalk(ji,jj) 533 write(charout5,*) mig(ji), mjg(jj), jk, kt 534 IF (lwp) CALL ctl_warn( 'trc_bio_medusa: carbonate chemistry WARNING:', & 535 TRIM(charout),TRIM(charout2),TRIM(charout3),TRIM(charout4), & 536 'at i, j, k, kt:', TRIM(charout5) ) 537 !! 538 !! Detect, report and correct tracer excursions 539 IF ( (ztmp(ji,jj) .LT. -3.0) .OR. (ztmp(ji,jj) .GT. 40.0) ) & 540 CALL trc_bio_exceptional_fix( & 541 tsn(ji-1:ji+1,jj-1:jj+1,jk,jp_tem), tmask(ji-1:ji+1,jj-1:jj+1,jk), & 542 'Tmp', -3.0, 40.0, ztmp(ji,jj) ) 543 !! 544 IF ( (zsal(ji,jj) .LE. 0.0) .OR. (zsal(ji,jj) .GT. 50.0) ) & 545 CALL trc_bio_exceptional_fix( & 546 tsn(ji-1:ji+1,jj-1:jj+1,jk,jp_sal), tmask(ji-1:ji+1,jj-1:jj+1,jk), & 547 'Sal', 1.0, 50.0, zsal(ji,jj) ) 548 !! 549 IF ( (zdic(ji,jj) .LE. 0.0) .OR. (zdic(ji,jj) .GT. 4.0E3) ) & 550 CALL trc_bio_exceptional_fix( & 551 trn(ji-1:ji+1,jj-1:jj+1,jk,jpdic), tmask(ji-1:ji+1,jj-1:jj+1,jk), & 552 'DIC', 100.0, 4.0E3, zdic(ji,jj) ) 553 !! 554 IF ( (zalk(ji,jj) .LE. 0.0) .OR. (zalk(ji,jj) .GT. 4.0E3) ) & 555 CALL trc_bio_exceptional_fix( & 556 trn(ji-1:ji+1,jj-1:jj+1,jk,jpalk), tmask(ji-1:ji+1,jj-1:jj+1,jk), & 557 'Alk', 100.0, 4.0E3, zalk(ji,jj) ) 558 ENDIF 559 ENDIF 560 ENDDO 561 ENDDO 562 # endif 563 504 564 # if defined key_debug_medusa 505 565 DO jj = 2,jpjm1 … … 657 717 END SUBROUTINE trc_bio_medusa 658 718 719 720 721 SUBROUTINE trc_bio_exceptional_fix(tiny_var, tiny_mask, var_nm, mini, maxi, varout) 722 !! JPALM (27/10/17): This function is called only when abnormal values that 723 !! could break the model's carbonate system are fed to MEDUSA 724 !! 725 !! The function calculates an average tracer value based on the 3x3 cell 726 !! neighbourhood around the abnormal cell, and reports this back 727 !! 728 !! Tracer array values are not modified, but MEDUSA uses "corrected" values 729 !! in its calculations 730 !! 731 !! temporary variables 732 REAL(wp), INTENT( in ), DIMENSION(3,3) :: tiny_var, tiny_mask 733 CHARACTER(25), INTENT( in ) :: var_nm 734 REAL(wp), INTENT( in ) :: mini, maxi 735 REAL(wp), INTENT( out ) :: varout 736 REAL(wp) :: sumtsn, tsnavg 737 INTEGER :: summask 738 CHARACTER(25) :: charout1, charout2 739 CHARACTER(60) :: charout3, charout4 740 INTEGER :: ii,ij 741 742 !! point to the center of the 3*3 zoom-grid, to check around 743 ii = 2 744 ij = 2 745 !! Print surounding values to check if isolated Crazy value or 746 !! General error 747 IF(lwp) WRITE(numout,*) & 748 '----------------------------------------------------------------------' 749 IF(lwp) WRITE(numout,*) & 750 'trc_bio_medusa: 3x3 neighbourhood surrounding abnormal ', TRIM(var_nm) 751 IF(lwp) WRITE(numout,9100) & 752 3, tiny_var(ii-1,ij+1), tiny_var(ii ,ij+1), tiny_var(ii+1,ij+1) 753 IF(lwp) WRITE(numout,9100) & 754 2, tiny_var(ii-1,ij ), tiny_var(ii ,ij ), tiny_var(ii+1,ij ) 755 IF(lwp) WRITE(numout,9100) & 756 1, tiny_var(ii-1,ij-1), tiny_var(ii ,ij-1), tiny_var(ii+1,ij-1) 757 IF(lwp) WRITE(numout,*) & 758 'trc_bio_medusa: 3x3 land-sea neighbourhood, tmask' 759 IF(lwp) WRITE(numout,9100) & 760 3, tiny_mask(ii-1,ij+1), tiny_mask(ii ,ij+1), tiny_mask(ii+1,ij+1) 761 IF(lwp) WRITE(numout,9100) & 762 2, tiny_mask(ii-1,ij ), tiny_mask(ii ,ij ), tiny_mask(ii+1,ij ) 763 IF(lwp) WRITE(numout,9100) & 764 1, tiny_mask(ii-1,ij-1), tiny_mask(ii ,ij-1), tiny_mask(ii+1,ij-1) 765 766 !! Correct out of range values 767 sumtsn = ( tiny_mask(ii-1,ij+1) * tiny_var(ii-1,ij+1) ) + & 768 ( tiny_mask(ii ,ij+1) * tiny_var(ii ,ij+1) ) + & 769 ( tiny_mask(ii+1,ij+1) * tiny_var(ii+1,ij+1) ) + & 770 ( tiny_mask(ii-1,ij ) * tiny_var(ii-1,ij ) ) + & 771 ( tiny_mask(ii+1,ij ) * tiny_var(ii+1,ij ) ) + & 772 ( tiny_mask(ii-1,ij-1) * tiny_var(ii-1,ij-1) ) + & 773 ( tiny_mask(ii ,ij-1) * tiny_var(ii ,ij-1) ) + & 774 ( tiny_mask(ii+1,ij-1) * tiny_var(ii+1,ij-1) ) 775 !! 776 summask = tiny_mask(ii-1,ij+1) + tiny_mask(ii ,ij+1) + & 777 tiny_mask(ii+1,ij+1) + tiny_mask(ii-1,ij ) + & 778 tiny_mask(ii+1,ij ) + tiny_mask(ii-1,ij-1) + & 779 tiny_mask(ii ,ij-1) + tiny_mask(ii+1,ij-1) 780 !! 781 IF ( summask .GT. 0 ) THEN 782 tsnavg = ( sumtsn / summask ) 783 varout = MAX( MIN( maxi, tsnavg), mini ) 784 ELSE 785 IF (ztmp(ii,ij) .LT. mini ) varout = mini 786 IF (ztmp(ii,ij) .GT. maxi ) varout = maxi 787 ENDIF 788 !! 789 write(charout1,9200) tiny_var(ii,ij) 790 write(charout2,9200) varout 791 write(charout3,*) ' ', charout1, ' -> ', charout2 792 write(charout4,*) ' Tracer: ', trim(var_nm) 793 IF(lwp) WRITE(numout,*) 'trc_bio_medusa: ** EXCEPTIONAL VALUE SWITCHING **' 794 IF(lwp) WRITE(numout,*) charout4 795 IF(lwp) WRITE(numout,*) charout3 796 IF(lwp) WRITE(numout,*) & 797 '----------------------------------------------------------------------' 798 IF(lwp) WRITE(numout,*) & 799 ' ' 800 9100 FORMAT('Row:', i1, ' ', e16.6, ' ', e16.6, ' ', e16.6) 801 9200 FORMAT(e16.6) 802 803 END SUBROUTINE trc_bio_exceptional_fix 804 805 SUBROUTINE trc_bio_check(kt) 806 !!----------------------------------- 807 !! JPALM -- 14-12-2017 -- Still dealing with this micro-boil/carb failure 808 !! problem. The model is now able to correct a local 809 !! crazy value. but does it silently. 810 !! We need to spread the word to the master node. we 811 !! don't want the model to correct values without telling us 812 !! This module will tell at least when crazy DIC or 813 !! ALK appears. 814 !!------------------------------------- 815 REAL(wp) :: zmax, zmin ! temporary scalars 816 INTEGER :: ji,jj ! dummy loop 817 INTEGER :: ii,ij ! temporary scalars 818 INTEGER, DIMENSION(2) :: ilocs ! 819 INTEGER, INTENT( in ) :: kt 820 !! 821 !!========================== 822 !! DIC Check 823 zmax = -5.e0 ! arbitrary low maximum value 824 zmin = 4.0E4 ! arbitrary high minimum value 825 DO jj = 2, jpjm1 826 DO ji = 1, jpi 827 IF( tmask(ji,jj,1) == 1) THEN 828 zmax = MAX(zmax,zdic(ji,jj)) ! find local maximum 829 zmin = MIN(zmin,zdic(ji,jj)) ! find local minimum 830 ENDIF 831 END DO 832 END DO 833 IF( lk_mpp ) CALL mpp_max( zmax ) ! max over the global domain 834 IF( lk_mpp ) CALL mpp_min( zmin ) ! min over the global domain 835 ! 836 IF( zmax > 4.0E3) THEN ! we've got a problem 837 IF (lk_mpp) THEN 838 CALL mpp_maxloc ( zdic(:,:),tmask(:,:,1), zmax, ii,ij ) 839 ELSE 840 ilocs = MAXLOC( zdic(:,:), mask = tmask(:,:,1) == 1.e0 ) 841 ii = ilocs(1) + nimpp - 1 842 ij = ilocs(2) + njmpp - 1 843 ENDIF 844 ! 845 IF(lwp) THEN 846 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** WARNING *****' 847 WRITE(numout,*) 'trc_bio:tracer anomaly: sea surface DIC > 4000 ' 848 WRITE(numout,9600) kt, zmax, ii, ij 849 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** END OF WARNING *****' 850 ENDIF 851 ENDIF 852 ! 853 IF( zmin <= 0.0) THEN ! we've got a problem 854 IF (lk_mpp) THEN 855 CALL mpp_minloc ( zdic(:,:),tmask(:,:,1), zmin, ii,ij ) 856 ELSE 857 ilocs = MINLOC( zdic(:,:), mask = tmask(:,:,1) == 1.e0 ) 858 ii = ilocs(1) + nimpp - 1 859 ij = ilocs(2) + njmpp - 1 860 ENDIF 861 ! 862 IF(lwp) THEN 863 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** WARNING *****' 864 WRITE(numout,*) 'trc_bio:tracer anomaly: sea surface DIC <= 0 ' 865 WRITE(numout,9700) kt, zmin, ii, ij 866 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** END OF WARNING *****' 867 ENDIF 868 ENDIF 869 !! 870 !!========================== 871 !! ALKALINITY Check 872 zmax = -5.e0 ! arbitrary low maximum value 873 zmin = 4.0E4 ! arbitrary high minimum value 874 DO jj = 2, jpjm1 875 DO ji = 1, jpi 876 IF( tmask(ji,jj,1) == 1) THEN 877 zmax = MAX(zmax,zalk(ji,jj)) ! find local maximum 878 zmin = MIN(zmin,zalk(ji,jj)) ! find local minimum 879 ENDIF 880 END DO 881 END DO 882 IF( lk_mpp ) CALL mpp_max( zmax ) ! max over the global domain 883 IF( lk_mpp ) CALL mpp_min( zmin ) ! min over the global domain 884 ! 885 IF( zmax > 4.0E3) THEN ! we've got a problem 886 IF (lk_mpp) THEN 887 CALL mpp_maxloc ( zalk(:,:),tmask(:,:,1), zmax, ii,ij ) 888 ELSE 889 ilocs = MAXLOC( zalk(:,:), mask = tmask(:,:,1) == 1.e0 ) 890 ii = ilocs(1) + nimpp - 1 891 ij = ilocs(2) + njmpp - 1 892 ENDIF 893 ! 894 IF(lwp) THEN 895 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** WARNING *****' 896 WRITE(numout,*) 'trc_bio:tracer anomaly: sea surface Alkalinity > 4000 ' 897 WRITE(numout,9800) kt, zmax, ii, ij 898 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** END OF WARNING *****' 899 ENDIF 900 ENDIF 901 ! 902 IF( zmin <= 0.0) THEN ! we've got a problem 903 IF (lk_mpp) THEN 904 CALL mpp_minloc ( zalk(:,:),tmask(:,:,1), zmin, ii,ij ) 905 ELSE 906 ilocs = MINLOC( zalk(:,:), mask = tmask(:,:,1) == 1.e0 ) 907 ii = ilocs(1) + nimpp - 1 908 ij = ilocs(2) + njmpp - 1 909 ENDIF 910 ! 911 IF(lwp) THEN 912 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** WARNING *****' 913 WRITE(numout,*) 'trc_bio:tracer anomaly: sea surface Alkalinity <= 0 ' 914 WRITE(numout,9900) kt, zmin, ii, ij 915 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** END OF WARNING *****' 916 ENDIF 917 ENDIF 918 919 920 9600 FORMAT ('trc_bio:tracer anomaly: kt=',i6,' max DIC: ',f16.10,', i j: ',2i5) 921 9700 FORMAT ('trc_bio:tracer anomaly: kt=',i6,' min DIC: ',f16.10,', i j: ',2i5) 922 9800 FORMAT ('trc_bio:tracer anomaly: kt=',i6,' max ALK: ',f16.10,', i j: ',2i5) 923 9900 FORMAT ('trc_bio:tracer anomaly: kt=',i6,' min ALK: ',f16.10,', i j: ',2i5) 924 925 END SUBROUTINE trc_bio_check 926 927 659 928 #else 660 929 !!===================================================================== -
branches/NERC/dev_r5518_GO6_Carb_Fail_from_GO6_8356/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r9070 r9073 43 43 USE sbc_oce, ONLY: lk_oasis 44 44 USE oce, ONLY: CO2Flux_out_cpl, DMS_out_cpl, chloro_out_cpl !! Coupling variable 45 USE trcstat 45 46 46 47 IMPLICIT NONE … … 52 53 PUBLIC trc_rst_cal 53 54 PUBLIC trc_rst_stat 54 PUBLIC trc_rst_dia_stat55 PUBLIC trc_rst_tra_stat56 55 57 56 !! * Substitutions … … 697 696 698 697 699 SUBROUTINE trc_rst_tra_stat700 !!----------------------------------------------------------------------701 !! *** trc_rst_tra_stat ***702 !!703 !! ** purpose : Compute tracers statistics - check where crazy values appears704 !!----------------------------------------------------------------------705 INTEGER :: jk, jn706 REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift, areasf707 REAL(wp), DIMENSION(jpi,jpj) :: zvol708 !!----------------------------------------------------------------------709 710 IF( lwp ) THEN711 WRITE(numout,*)712 WRITE(numout,*) ' ----SURFACE TRA STAT---- '713 WRITE(numout,*)714 ENDIF715 !716 zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1)717 areasf = glob_sum(zvol(:,:))718 DO jn = 1, jptra719 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 ) THEN723 CALL mpp_min( zmin ) ! min over the global domain724 CALL mpp_max( zmax ) ! max over the global domain725 END IF726 zmean = ztraf / areasf727 IF(lwp) WRITE(numout,9001) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax728 END DO729 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_stat734 735 736 737 SUBROUTINE trc_rst_dia_stat( dgtr, names)738 !!----------------------------------------------------------------------739 !! *** trc_rst_dia_stat ***740 !!741 !! ** purpose : Compute tracers statistics742 !!----------------------------------------------------------------------743 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: dgtr ! 2D diag var744 CHARACTER(len=*) , INTENT(in) :: names ! 2D diag name745 !!---------------------------------------------------------------------746 INTEGER :: jk, jn747 CHARACTER (LEN=18) :: text_zmean748 REAL(wp) :: ztraf, zmin, zmax, zmean, areasf749 REAL(wp), DIMENSION(jpi,jpj) :: zvol750 !!----------------------------------------------------------------------751 752 IF( lwp ) WRITE(numout,*) 'STAT- ', names753 754 ! fse3t_a will be undefined at the start of a run, but this routine755 ! may be called at any stage! Hence we MUST make sure it is756 ! initialised to zero when allocated to enable us to test for757 ! zero content here and avoid potentially dangerous and non-portable758 ! operations (e.g. divide by zero, global sums of junk values etc.)759 zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1)760 ztraf = glob_sum( dgtr(:,:) * zvol(:,:) )761 !! areasf = glob_sum(e1e2t(:,:) * tmask(:,:,1) )762 areasf = glob_sum(zvol(:,:))763 zmin = MINVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) )764 zmax = MAXVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) )765 IF( lk_mpp ) THEN766 CALL mpp_min( zmin ) ! min over the global domain767 CALL mpp_max( zmax ) ! max over the global domain768 END IF769 770 text_zmean = "N/A"771 ! Avoid divide by zero. areasf must be positive.772 IF (areasf > 0.0) THEN773 zmean = ztraf / areasf774 WRITE(text_zmean,'(e18.10)') zmean775 ENDIF776 777 IF(lwp) WRITE(numout,9002) TRIM( names ), text_zmean, zmin, zmax778 779 9002 FORMAT(' tracer name :',A,' mean :',A,' min :',e18.10, &780 & ' max :',e18.10 )781 !782 END SUBROUTINE trc_rst_dia_stat783 784 785 698 #else 786 699 !!---------------------------------------------------------------------- -
branches/NERC/dev_r5518_GO6_Carb_Fail_from_GO6_8356/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r9070 r9073 19 19 USE trcwri 20 20 USE trcrst 21 USE trcstat 21 22 USE trdtrc_oce 22 23 USE trdmxl_trc
Note: See TracChangeset
for help on using the changeset viewer.
