Changeset 9257
- Timestamp:
- 2018-01-18T11:14:03+01:00 (6 years ago)
- Location:
- branches/UKMO/dev_r5518_GO6_package/NEMOGCM
- Files:
-
- 5 edited
-
CONFIG/SHARED/field_def_bgc.xml (modified) (3 diffs)
-
NEMO/OPA_SRC/stpctl.F90 (modified) (2 diffs)
-
NEMO/TOP_SRC/MEDUSA/air_sea.F90 (modified) (6 diffs)
-
NEMO/TOP_SRC/MEDUSA/bio_medusa_init.F90 (modified) (1 diff)
-
NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/CONFIG/SHARED/field_def_bgc.xml
r9163 r9257 1645 1645 <field_group id="groupMEDUSA" > 1646 1646 <field field_ref="CHN" name="CHN" /> 1647 <field field_ref="CHN_ INV" name="CHN_INV"/>1647 <field field_ref="CHN_E3T" name="CHN_E3T" /> 1648 1648 <field field_ref="SURF_CHN" name="SURF_CHN" /> 1649 1649 <field field_ref="CHD" name="CHD" /> 1650 <field field_ref="CHD_ INV" name="CHD_INV"/>1650 <field field_ref="CHD_E3T" name="CHD_E3T" /> 1651 1651 <field field_ref="SURF_CHD" name="SURF_CHD" /> 1652 1652 <field field_ref="PHN" name="PHN" /> 1653 <field field_ref="PHN_E3T" name="PHN_E3T" /> 1654 <field field_ref="PHD" name="PHD" /> 1655 <field field_ref="PHD_E3T" name="PHD_E3T" /> 1656 <field field_ref="ZMI" name="ZMI" /> 1657 <field field_ref="ZMI_E3T" name="ZMI_E3T" /> 1658 <field field_ref="ZME" name="ZME" /> 1659 <field field_ref="ZME_E3T" name="ZME_E3T" /> 1660 <field field_ref="DIN" name="DIN" /> 1661 <field field_ref="DIN_E3T" name="DIN_E3T" /> 1662 <field field_ref="SIL" name="SIL" /> 1663 <field field_ref="SIL_E3T" name="SIL_E3T" /> 1664 <field field_ref="FER" name="FER" /> 1665 <field field_ref="FER_E3T" name="FER_E3T" /> 1666 <field field_ref="DET" name="DET" /> 1667 <field field_ref="DET_E3T" name="DET_E3T" /> 1668 <field field_ref="PDS" name="PDS" /> 1669 <field field_ref="PDS_E3T" name="PDS_E3T" /> 1670 <field field_ref="DTC" name="DTC" /> 1671 <field field_ref="DTC_E3T" name="DTC_E3T" /> 1672 <field field_ref="DiC" name="DIC" /> 1673 <field field_ref="DiC_E3T" name="DIC_E3T" /> 1674 <field field_ref="ALK" name="ALK" /> 1675 <field field_ref="ALK_E3T" name="ALK_E3T" /> 1676 <field field_ref="OXY" name="OXY" /> 1677 <field field_ref="OXY_E3T" name="OXY_E3T" /> 1678 </field_group> 1679 1680 1681 <field_group id="groupMEDUSA_INV" > 1682 <field field_ref="CHN_INV" name="CHN_INV" /> 1683 <field field_ref="CHD_INV" name="CHD_INV" /> 1653 1684 <field field_ref="PHN_INV" name="PHN_INV" /> 1654 <field field_ref="PHD" name="PHD" />1655 1685 <field field_ref="PHD_INV" name="PHD_INV" /> 1656 <field field_ref="ZMI" name="ZMI" />1657 1686 <field field_ref="ZMI_INV" name="ZMI_INV" /> 1658 <field field_ref="ZME" name="ZME" />1659 1687 <field field_ref="ZME_INV" name="ZME_INV" /> 1660 <field field_ref="DIN" name="DIN" />1661 1688 <field field_ref="DIN_INV" name="DIN_INV" /> 1662 <field field_ref="SIL" name="SIL" />1663 1689 <field field_ref="SIL_INV" name="SIL_INV" /> 1664 <field field_ref="FER" name="FER" />1665 1690 <field field_ref="FER_INV" name="FER_INV" /> 1666 <field field_ref="DET" name="DET" />1667 1691 <field field_ref="DET_INV" name="DET_INV" /> 1668 <field field_ref="PDS" name="PDS" />1669 1692 <field field_ref="PDS_INV" name="PDS_INV" /> 1670 <field field_ref="DTC" name="DTC" />1671 1693 <field field_ref="DTC_INV" name="DTC_INV" /> 1672 <field field_ref="DiC" name="DIC" />1673 1694 <field field_ref="DiC_INV" name="DIC_INV" /> 1674 <field field_ref="ALK" name="ALK" />1675 1695 <field field_ref="ALK_INV" name="ALK_INV" /> 1676 <field field_ref="OXY" name="OXY" />1677 1696 <field field_ref="OXY_INV" name="OXY_INV" /> 1678 1697 </field_group> … … 1685 1704 <field field_ref="qtrIDTRA" name="qtrIDTRA" /> 1686 1705 <field field_ref="qintIDTRA" name="qintIDTRA" /> 1687 <field field_ref=" IDTRA_INV" name="IDTRA_INV" />1706 <field field_ref="invIDTRA" name="invIDTRA" /> 1688 1707 </field_group> 1689 1708 1690 1709 <field_group id="groupCFC" > 1691 1710 <field field_ref="CFC11" name="CFC11" /> 1711 <field field_ref="CFC11_E3T" name="CFC11_E3T" /> 1692 1712 <field field_ref="CFC12" name="CFC12" /> 1713 <field field_ref="CFC12_E3T" name="CFC12_E3T" /> 1693 1714 <field field_ref="SF6" name="SF6" /> 1715 <field field_ref="SF6_E3T" name="SF6_E3T" /> 1694 1716 </field_group> 1695 1717 … … 1697 1719 <field field_ref="qtrCFC11" name="qtrCFC11" /> 1698 1720 <field field_ref="qintCFC11" name="qintCFC11" /> 1699 <field field_ref="CFC11_INV" name="CFC11_INV" />1700 1721 <field field_ref="qtrCFC12" name="qtrCFC12" /> 1701 1722 <field field_ref="qintCFC12" name="qintCFC12" /> 1702 <field field_ref="CFC12_INV" name="CFC12_INV" />1703 1723 <field field_ref="qtrSF6" name="qtrSF6" /> 1704 1724 <field field_ref="qintSF6" name="qintSF6" /> 1705 <field field_ref="SF6_INV" name="SF6_INV" />1706 1725 </field_group> 1707 1726 -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/stpctl.F90
r6487 r9257 58 58 INTEGER :: ii, ij, ik ! temporary integers 59 59 REAL(wp) :: zumax, zsmin, zssh2 ! temporary scalars 60 REAL(wp) :: ztmax, ztmin ! Scalar to get temperature extreme 61 ! values and warn if they're out of Range 60 62 INTEGER, DIMENSION(3) :: ilocu ! 61 63 INTEGER, DIMENSION(2) :: ilocs ! … … 148 150 9500 FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i5) 149 151 152 ! ==================================================================================================== 153 ! ==================================================================================================== 154 ! !AXY (25/10/17) 155 ! !* Test max/min limits of temperature 156 ! ! ---------------------------------- 157 ztmax = -5.e0 ! arbitrary low maximum value 158 ztmin = 100.e0 ! arbitrary high minimum value 159 DO jj = 2, jpjm1 160 DO ji = 2, jpim1 161 IF( tmask(ji,jj,1) == 1) THEN 162 ztmax = MAX(ztmax,tsn(ji,jj,1,jp_tem)) ! find local maximum 163 ztmin = MIN(ztmin,tsn(ji,jj,1,jp_tem)) ! find local minimum 164 ENDIF 165 END DO 166 END DO 167 IF( lk_mpp ) CALL mpp_max( ztmax ) ! max over the global domain 168 IF( lk_mpp ) CALL mpp_min( ztmin ) ! min over the global domain 169 ! 170 IF( ztmax > 40.) THEN ! we've got a problem 171 IF (lk_mpp) THEN 172 CALL mpp_maxloc ( tsn(:,:,1,jp_tem),tmask(:,:,1), ztmax, ii,ij ) 173 ELSE 174 ilocs = MAXLOC( tsn(:,:,1,jp_tem), mask = tmask(:,:,1) == 1.e0 ) 175 ii = ilocs(1) + nimpp - 1 176 ij = ilocs(2) + njmpp - 1 177 ENDIF 178 ! 179 IF(lwp) THEN 180 WRITE(numout,*) 'stp_ctl:tracer anomaly: ***** WARNING *****' 181 WRITE(numout,*) 'stp_ctl:tracer anomaly: sea surface temperature > 40C' 182 WRITE(numout,9600) kt, ztmax, ii, ij 183 WRITE(numout,*) 'stp_ctl:tracer anomaly: ***** END OF WARNING *****' 184 ENDIF 185 ENDIF 186 ! 187 IF( ztmin < -3.) THEN ! we've got a problem 188 IF (lk_mpp) THEN 189 CALL mpp_minloc ( tsn(:,:,1,jp_tem),tmask(:,:,1), ztmin, ii,ij ) 190 ELSE 191 ilocs = MINLOC( tsn(:,:,1,jp_tem), mask = tmask(:,:,1) == 1.e0 ) 192 ii = ilocs(1) + nimpp - 1 193 ij = ilocs(2) + njmpp - 1 194 ENDIF 195 ! 196 IF(lwp) THEN 197 WRITE(numout,*) 'stp_ctl:tracer anomaly: ***** WARNING *****' 198 WRITE(numout,*) 'stp_ctl:tracer anomaly: sea surface temperature < -3C' 199 WRITE(numout,9700) kt, ztmin, ii, ij 200 WRITE(numout,*) 'stp_ctl:tracer anomaly: ***** END OF WARNING *****' 201 ENDIF 202 ENDIF 203 9600 FORMAT ('stp_ctl:tracer anomaly: kt=',i6,' max SST: ',f16.10,', i j: ',2i5) 204 9700 FORMAT ('stp_ctl:tracer anomaly: kt=',i6,' min SST: ',f16.10,', i j: ',2i5) 205 ! ==================================================================================================== 206 ! ==================================================================================================== 150 207 151 208 IF( lk_c1d ) RETURN ! No log file in case of 1D vertical configuration -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/air_sea.F90
r8521 r9257 62 62 # endif 63 63 zchd, zchn, zdin, zsil 64 USE dom_oce, ONLY: e3t_0, e3t_n, gphit, tmask 64 USE dom_oce, ONLY: e3t_0, e3t_n, gphit, tmask, mig, mjg 65 65 # if defined key_iomput 66 66 USE iom, ONLY: lk_iomput … … 91 91 USE trcoxy_medusa, ONLY: trc_oxy_medusa 92 92 # endif 93 USE lib_mpp, ONLY: ctl_stop 94 USE trcstat, ONLY: trc_rst_dia_stat 93 95 94 96 !!* Substitution … … 122 124 123 125 # if defined key_roam 126 !! init 127 f_fco2w(:,:) = 0.0 128 f_fco2atm(:,:) = 0.0 129 f_schmidtco2(:,:) = 0.0 130 f_kwco2(:,:) = 0.0 131 f_co2starair(:,:) = 0.0 132 f_dpco2(:,:) = 0.0 133 f_rhosw(:,:) = 0.0 134 f_K0(:,:) = 0.0 135 !! air pressure (atm); ultimately this will use air 136 !! pressure at the base of the UKESM1 atmosphere 137 !! 138 f_pp0(:,:) = 1.0 139 140 124 141 !!----------------------------------------------------------- 125 142 !! Air-sea gas exchange … … 134 151 DO ji = 2,jpim1 135 152 !! OPEN wet point IF..THEN loop 136 if(tmask(ji,jj,1) == 1) then153 IF (tmask(ji,jj,1) == 1) then 137 154 IF (lk_oasis) THEN 138 155 !! use 2D atm xCO2 from atm coupling 139 156 f_xco2a(ji,jj) = PCO2a_in_cpl(ji,jj) 157 !!! 158 !!! Jpalm test on atm xCO2 159 IF ( (f_xco2a(ji,jj) > 1500.0 ).OR.(f_xco2a(ji,jj) < 100.0 ) ) THEN 160 IF(lwp) THEN 161 WRITE(numout,*) ' atm xCO2 = ',f_xco2a(ji,jj), & 162 ' -- ji =', mig(ji),' jj = ', mjg(jj) 163 ENDIF 164 CALL ctl_stop( 'MEDUSA - Air-Sea :', 'unrealistic atm xCO2 ' ) 165 ENDIF 140 166 ENDIF 141 167 !! … … 162 188 'air-sea: carb-chem kt = ', kt 163 189 CALL flush(numout) 190 !! JPALM add carb print: 191 call trc_rst_dia_stat(f_xco2a(:,:), 'f_xco2a') 192 call trc_rst_dia_stat(wndm(:,:), 'wndm') 193 call trc_rst_dia_stat(f_kw660(:,:), 'f_kw660') 194 call trc_rst_dia_stat(ztmp(:,:), 'ztmp') 195 call trc_rst_dia_stat(zsal(:,:), 'zsal') 196 call trc_rst_dia_stat(zalk(:,:), 'zalk') 197 call trc_rst_dia_stat(zdic(:,:), 'zdic') 198 call trc_rst_dia_stat(zsil(:,:), 'zsil') 199 call trc_rst_dia_stat(zpho(:,:), 'zpho') 164 200 # endif 165 201 DO jj = 2,jpjm1 166 202 DO ji = 2,jpim1 167 203 if (tmask(ji,jj,1) == 1) then 168 !! air pressure (atm); ultimately this will use air169 !! pressure at the base of the UKESM1 atmosphere170 !!171 f_pp0(ji,jj) = 1.0172 !!173 !! IF(lwp) WRITE(numout,*) ' MEDUSA ztmp =', ztmp(ji,jj)174 !! IF(lwp) WRITE(numout,*) ' MEDUSA wndm =', wndm(ji,jj)175 !! IF(lwp) WRITE(numout,*) ' MEDUSA fr_i =', fr_i(ji,jj)176 204 !! 177 205 # if defined key_axy_carbchem 178 206 # if defined key_mocsy 207 !! Jpalm -- 12-09-2017 -- add extra check after reccurent 208 !! carbonate failure in the coupled run. 209 !! must be associated to air-sea flux or air xCO2... 210 !! Check MOCSY inputs 211 IF ( (zsal(ji,jj) > 75.0 ).OR.(zsal(ji,jj) < 0.0 ) .OR. & 212 (ztmp(ji,jj) > 50.0 ).OR.(ztmp(ji,jj) < -20.0 ) .OR. & 213 (zalk(ji,jj) > 35.0E2 ).OR.(zalk(ji,jj) <= 0.0 ) .OR. & 214 (zdic(ji,jj) > 35.0E2 ).OR.(zdic(ji,jj) <= 0.0 ) .OR. & 215 (f_kw660(ji,jj) > 1.0E-2 ).OR.(f_kw660(ji,jj) < 0.0 ) ) THEN 216 IF(lwp) THEN 217 WRITE(numout,*) ' surface T = ',ztmp(ji,jj) 218 WRITE(numout,*) ' surface S = ',zsal(ji,jj) 219 WRITE(numout,*) ' surface ALK = ',zalk(ji,jj) 220 WRITE(numout,*) ' surface DIC = ',zdic(ji,jj) 221 WRITE(numout,*) ' KW660 = ',f_kw660(ji,jj) 222 WRITE(numout,*) ' atm xCO2 = ',f_xco2a(ji,jj) 223 WRITE(numout,*) ' surface pco2w = ',f_pco2w(ji,jj) 224 WRITE(numout,*) ' surface fco2w = ',f_fco2w(ji,jj) 225 WRITE(numout,*) ' surface fco2a = ',f_fco2atm(ji,jj) 226 WRITE(numout,*) ' surface co2flx = ',f_co2flux(ji,jj) 227 WRITE(numout,*) ' surface dpco2 = ',f_dpco2(ji,jj) 228 WRITE(numout,*) ' MOCSY input: ji =', mig(ji),' jj = ', mjg(jj), & 229 ' kt = ', kt 230 WRITE(numout,*) 'MEDUSA - Air-Sea INPUT: unrealistic surface Carb. Chemistry' 231 ENDIF 232 CALL ctl_stop( 'MEDUSA - Air-Sea INPUT: ', & 233 'unrealistic surface Carb. Chemistry -- INPUTS' ) 234 ENDIF 179 235 !! 180 236 !! AXY (22/06/15): use Orr & Epitalon (2015) MOCSY-2 carbonate … … 201 257 f_TALK(ji,jj) = (zalk(ji,jj) / f_rhosw(ji,jj)) * 1000. 202 258 f_dcf(ji,jj) = f_rhosw(ji,jj) 259 !! Jpalm -- 12-09-2017 -- add extra check after reccurent 260 !! carbonate failure in the coupled run. 261 !! must be associated to air-sea flux or air xCO2... 262 !! Check MOCSY outputs 263 IF ( (f_pco2w(ji,jj) > 1.E4 ).OR.(f_pco2w(ji,jj) < 0.0 ) .OR. & 264 (f_fco2w(ji,jj) > 1.E4 ).OR.(f_fco2w(ji,jj) < 0.0 ) .OR. & 265 (f_fco2atm(ji,jj) > 1.E4 ).OR.(f_fco2atm(ji,jj) < 0.0 ) .OR. & 266 (f_co2flux(ji,jj) > 1.E-2 ).OR.(f_co2flux(ji,jj) < -1.E-2 ) .OR. & 267 (f_dpco2(ji,jj) > 1.E4 ).OR.(f_dpco2(ji,jj) < -1.E4 ) ) THEN 268 IF(lwp) THEN 269 WRITE(numout,*) ' surface T = ',ztmp(ji,jj) 270 WRITE(numout,*) ' surface S = ',zsal(ji,jj) 271 WRITE(numout,*) ' surface ALK = ',zalk(ji,jj) 272 WRITE(numout,*) ' surface DIC = ',zdic(ji,jj) 273 WRITE(numout,*) ' KW660 = ',f_kw660(ji,jj) 274 WRITE(numout,*) ' atm xCO2 = ',f_xco2a(ji,jj) 275 WRITE(numout,*) ' surface pco2w = ',f_pco2w(ji,jj) 276 WRITE(numout,*) ' surface fco2w = ',f_fco2w(ji,jj) 277 WRITE(numout,*) ' surface fco2a = ',f_fco2atm(ji,jj) 278 WRITE(numout,*) ' surface co2flx = ',f_co2flux(ji,jj) 279 WRITE(numout,*) ' surface dpco2 = ',f_dpco2(ji,jj) 280 WRITE(numout,*) ' MOCSY output: ji =', mig(ji),' jj = ', mjg(jj), & 281 ' kt = ', kt 282 WRITE(numout,*) 'MEDUSA - Air-Sea OUTPUT: unrealistic surface Carb. Chemistry' 283 ENDIF 284 CALL ctl_stop( 'MEDUSA - Air-Sea OUTPUT: ', & 285 'unrealistic surface Carb. Chemistry -- OUTPUTS' ) 286 ENDIF 203 287 ENDIF 204 288 ENDDO 205 289 ENDDO 206 290 291 # if defined key_debug_medusa 292 !! JPALM add carb print: 293 call trc_rst_dia_stat(f_pco2w(:,:), 'f_pco2w') 294 call trc_rst_dia_stat(f_fco2w(:,:), 'f_fco2w') 295 call trc_rst_dia_stat(f_fco2atm(:,:), 'f_fco2atm') 296 call trc_rst_dia_stat(f_schmidtco2(:,:), 'f_schmidtco2') 297 call trc_rst_dia_stat(f_kwco2(:,:), 'f_kwco2') 298 call trc_rst_dia_stat(f_co2starair(:,:), 'f_co2starair') 299 call trc_rst_dia_stat(f_co2flux(:,:), 'f_co2flux') 300 call trc_rst_dia_stat(f_dpco2(:,:), 'f_dpco2') 301 # endif 207 302 # else 208 303 -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_init.F90
r8521 r9257 167 167 fslownflux(:,:) = 0.0 168 168 fslowcflux(:,:) = 0.0 169 !! 170 !! JPALM -- 21-09-2017 -- needed to debug air-sea carb 171 f_xco2a(:,:) = 0.0 172 f_pco2w(:,:) = 0.0 173 f_ph(:,:) = 0.0 174 f_kw660(:,:) = 0.0 175 ztmp(:,:) = 0.0 176 zsal(:,:) = 0.0 177 zalk(:,:) = 0.0 178 zdic(:,:) = 0.0 179 zsil(:,:) = 0.0 180 zpho(:,:) = 0.0 181 f_co2flux(:,:) = 0.0 182 f_pco2atm(:,:) = 0.0 183 f_h2co3(:,:) = 0.0 184 f_hco3(:,:) = 0.0 185 f_co3(:,:) = 0.0 186 f_omarg(:,:) = 0.0 187 f_omcal(:,:) = 0.0 169 188 !! 170 189 !! AXY (08/08/17): zero slow detritus fluxes -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90
r8442 r9257 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_stop 91 USE lib_mpp, ONLY: mpp_max, mpp_maxloc, & 92 mpp_min, mpp_minloc, & 93 ctl_stop, ctl_warn, lk_mpp 90 94 USE oce, ONLY: tsb, tsn 91 95 USE par_kind, ONLY: wp … … 115 119 116 120 PUBLIC trc_bio_medusa ! called in trcsms_medusa.F90 121 PUBLIC trc_bio_exceptionnal_fix ! here 117 122 118 123 !!* Substitution … … 177 182 !! temporary variables 178 183 REAL(wp) :: fq0,fq1,fq2,fq3,fq4 184 !! 185 !! T and S check temporary variable 186 REAL(wp) :: sumtsn, tsnavg 187 INTEGER :: summask 188 CHARACTER(40) :: charout, charout2, charout3, charout4, charout5 179 189 !! 180 190 !!------------------------------------------------------------------ … … 450 460 451 461 # if defined key_roam 462 !! extra MEDUSA-2 tracers 452 463 DO jj = 2,jpjm1 453 464 DO ji = 2,jpim1 … … 456 467 zdtc(ji,jj) = max(0.,trn(ji,jj,jk,jpdtc)) 457 468 !! dissolved inorganic carbon 458 zdic(ji,jj) = max(0.,trn(ji,jj,jk,jpdic))469 zdic(ji,jj) = trn(ji,jj,jk,jpdic) 459 470 !! alkalinity 460 zalk(ji,jj) = max(0.,trn(ji,jj,jk,jpalk))471 zalk(ji,jj) = trn(ji,jj,jk,jpalk) 461 472 !! oxygen 462 473 zoxy(ji,jj) = max(0.,trn(ji,jj,jk,jpoxy)) … … 470 481 ztmp(ji,jj) = tsn(ji,jj,jk,jp_tem) 471 482 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 483 ENDIF 492 484 ENDDO 493 485 ENDDO 494 486 # else 487 !! diagnostic MEDUSA-1 detrital carbon tracer 495 488 DO jj = 2,jpjm1 496 489 DO ji = 2,jpim1 497 if (tmask(ji,jj,jk) == 1) then490 IF (tmask(ji,jj,jk) == 1) THEN 498 491 !! implicit detrital carbon 499 492 zdtc(ji,jj) = zdet(ji,jj) * xthetad … … 502 495 ENDDO 503 496 # endif 497 498 # if defined key_roam 499 !! --------------------------------------------- 500 !! JPALM -- 14-12-2017 -- Here, before any exeptionnal crazy value is 501 !! removed, we want to tell to the Master Processor that this 502 !! Exceptionnal value did exist 503 !! 504 Call trc_bio_check(kt) 505 506 !!================================================================ 507 !! AXY (03/11/17): check input fields 508 !! tracer values that exceed thresholds can cause carbonate system 509 !! failures when passed to MOCSY; temporary temperature excursions 510 !! in recent UKESM0.8 runs trigger such failures but are too short 511 !! to have physical consequences; this section checks for such 512 !! values and amends them using neighbouring values 513 !! 514 !! the check on temperature here is also carried out at the end of 515 !! each model time step and anomalies are reported in the master 516 !! ocean.output file; the error reporting below is strictly local 517 !! to the relevant ocean.output_XXXX file so will not be visible 518 !! unless all processors are reporting output 519 !!================================================================ 520 !! 521 DO jj = 2,jpjm1 522 DO ji = 2,jpim1 523 if (tmask(ji,jj,jk) == 1) then 524 !! the thresholds for the four tracers are ... 525 IF ( (ztmp(ji,jj) .LT. -3.0) .OR. (ztmp(ji,jj) .GT. 40.0 ) .OR. & 526 (zsal(ji,jj) .LE. 0.0) .OR. (zsal(ji,jj) .GT. 50.0 ) .OR. & 527 (zdic(ji,jj) .LE. 0.0) .OR. (zdic(ji,jj) .GT. 4.0E3 ) .OR. & 528 (zalk(ji,jj) .LE. 0.0) .OR. (zalk(ji,jj) .GT. 4.0E3 ) ) THEN 529 !! 530 !! all tracer values are reported in the event of any excursion 531 IF (lwp) THEN 532 WRITE(charout,*) ' Tmp = ', ztmp(ji,jj) 533 WRITE(charout2,*) ' Sal = ', zsal(ji,jj) 534 WRITE(charout3,*) ' DIC = ', zdic(ji,jj) 535 WRITE(charout4,*) ' Alk = ', zalk(ji,jj) 536 WRITE(charout5,*) mig(ji), mjg(jj), jk, kt 537 CALL ctl_warn( 'trc_bio_medusa: carbonate chemistry WARNING:', & 538 TRIM(charout),TRIM(charout2),TRIM(charout3),TRIM(charout4), & 539 'at i, j, k, kt:', TRIM(charout5) ) 540 ENDIF 541 !! 542 !! Detect, report and correct tracer excursions 543 IF ( (ztmp(ji,jj) .LT. -3.0) .OR. (ztmp(ji,jj) .GT. 40.0) ) & 544 CALL trc_bio_exceptionnal_fix( & 545 tsn(ji-1:ji+1,jj-1:jj+1,jk,jp_tem), tmask(ji-1:ji+1,jj-1:jj+1,jk), & 546 'Tmp', -3.0, 40.0, ztmp(ji,jj) ) 547 !! 548 IF ( (zsal(ji,jj) .LE. 0.0) .OR. (zsal(ji,jj) .GT. 50.0) ) & 549 CALL trc_bio_exceptionnal_fix( & 550 tsn(ji-1:ji+1,jj-1:jj+1,jk,jp_sal), tmask(ji-1:ji+1,jj-1:jj+1,jk), & 551 'Sal', 1.0, 50.0, zsal(ji,jj) ) 552 !! 553 IF ( (zdic(ji,jj) .LE. 0.0) .OR. (zdic(ji,jj) .GT. 4.0E3) ) & 554 CALL trc_bio_exceptionnal_fix( & 555 trn(ji-1:ji+1,jj-1:jj+1,jk,jpdic), tmask(ji-1:ji+1,jj-1:jj+1,jk), & 556 'DIC', 100.0, 4.0E3, zdic(ji,jj) ) 557 !! 558 IF ( (zalk(ji,jj) .LE. 0.0) .OR. (zalk(ji,jj) .GT. 4.0E3) ) & 559 CALL trc_bio_exceptionnal_fix( & 560 trn(ji-1:ji+1,jj-1:jj+1,jk,jpalk), tmask(ji-1:ji+1,jj-1:jj+1,jk), & 561 'Alk', 100.0, 4.0E3, zalk(ji,jj) ) 562 ENDIF 563 ENDIF 564 ENDDO 565 ENDDO 566 # endif 567 504 568 # if defined key_debug_medusa 505 569 DO jj = 2,jpjm1 … … 657 721 END SUBROUTINE trc_bio_medusa 658 722 723 724 725 SUBROUTINE trc_bio_exceptionnal_fix(tiny_var, tiny_mask, var_nm, mini, maxi, varout) 726 !! JPALM (27/10/17): This function is called only when abnormal values that 727 !! could break the model's carbonate system are fed to MEDUSA 728 !! 729 !! The function calculates an average tracer value based on the 3x3 cell 730 !! neighbourhood around the abnormal cell, and reports this back 731 !! 732 !! Tracer array values are not modified, but MEDUSA uses "corrected" values 733 !! in its calculations 734 !! 735 !! temporary variables 736 REAL(wp), INTENT( in ), DIMENSION(3,3) :: tiny_var, tiny_mask 737 CHARACTER(25), INTENT( in ) :: var_nm 738 REAL(wp), INTENT( in ) :: mini, maxi 739 REAL(wp), INTENT( out ) :: varout 740 REAL(wp) :: sumtsn, tsnavg 741 INTEGER :: summask 742 CHARACTER(25) :: charout1, charout2 743 CHARACTER(60) :: charout3, charout4 744 INTEGER :: ii,ij 745 746 !! point to the center of the 3*3 zoom-grid, to check around 747 ii = 2 748 ij = 2 749 !! Print surounding values to check if isolated Crazy value or 750 !! General error 751 IF(lwp) THEN 752 WRITE(numout,*) & 753 '----------------------------------------------------------------------' 754 WRITE(numout,*) & 755 'trc_bio_medusa: 3x3 neighbourhood surrounding abnormal ', TRIM(var_nm) 756 WRITE(numout,9100) & 757 3, tiny_var(ii-1,ij+1), tiny_var(ii ,ij+1), tiny_var(ii+1,ij+1) 758 WRITE(numout,9100) & 759 2, tiny_var(ii-1,ij ), tiny_var(ii ,ij ), tiny_var(ii+1,ij ) 760 WRITE(numout,9100) & 761 1, tiny_var(ii-1,ij-1), tiny_var(ii ,ij-1), tiny_var(ii+1,ij-1) 762 WRITE(numout,*) & 763 'trc_bio_medusa: 3x3 land-sea neighbourhood, tmask' 764 WRITE(numout,9100) & 765 3, tiny_mask(ii-1,ij+1), tiny_mask(ii ,ij+1), tiny_mask(ii+1,ij+1) 766 WRITE(numout,9100) & 767 2, tiny_mask(ii-1,ij ), tiny_mask(ii ,ij ), tiny_mask(ii+1,ij ) 768 WRITE(numout,9100) & 769 1, tiny_mask(ii-1,ij-1), tiny_mask(ii ,ij-1), tiny_mask(ii+1,ij-1) 770 ENDIF 771 !! Correct out of range values 772 sumtsn = ( 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 ( tiny_mask(ii-1,ij ) * tiny_var(ii-1,ij ) ) + & 776 ( tiny_mask(ii+1,ij ) * tiny_var(ii+1,ij ) ) + & 777 ( tiny_mask(ii-1,ij-1) * tiny_var(ii-1,ij-1) ) + & 778 ( tiny_mask(ii ,ij-1) * tiny_var(ii ,ij-1) ) + & 779 ( tiny_mask(ii+1,ij-1) * tiny_var(ii+1,ij-1) ) 780 !! 781 summask = tiny_mask(ii-1,ij+1) + tiny_mask(ii ,ij+1) + & 782 tiny_mask(ii+1,ij+1) + tiny_mask(ii-1,ij ) + & 783 tiny_mask(ii+1,ij ) + tiny_mask(ii-1,ij-1) + & 784 tiny_mask(ii ,ij-1) + tiny_mask(ii+1,ij-1) 785 !! 786 IF ( summask .GT. 0 ) THEN 787 tsnavg = ( sumtsn / summask ) 788 varout = MAX( MIN( maxi, tsnavg), mini ) 789 ELSE 790 IF (ztmp(ii,ij) .LT. mini ) varout = mini 791 IF (ztmp(ii,ij) .GT. maxi ) varout = maxi 792 ENDIF 793 !! 794 IF (lwp) THEN 795 WRITE(charout1,9200) tiny_var(ii,ij) 796 WRITE(charout2,9200) varout 797 WRITE(charout3,*) ' ', charout1, ' -> ', charout2 798 WRITE(charout4,*) ' Tracer: ', trim(var_nm) 799 !! 800 WRITE(numout,*) 'trc_bio_medusa: ** EXCEPTIONAL VALUE SWITCHING **' 801 WRITE(numout,*) charout4 802 WRITE(numout,*) charout3 803 WRITE(numout,*) '----------------------------------------------------------------------' 804 WRITE(numout,*) ' ' 805 ENDIF 806 807 9100 FORMAT('Row:', i1, ' ', e16.6, ' ', e16.6, ' ', e16.6) 808 9200 FORMAT(e16.6) 809 810 END SUBROUTINE trc_bio_exceptionnal_fix 811 812 SUBROUTINE trc_bio_check(kt) 813 !!----------------------------------- 814 !! JPALM -- 14-12-2017 -- Still dealing with this micro-boil/carb failure 815 !! problem. The model is now able to correct a local 816 !! crazy value. but does it silently. 817 !! We need to spread the word to the master processor. we 818 !! don't want the model to correct values without telling us 819 !! This module will tell at least when crazy DIC or 820 !! ALK appears. 821 !!------------------------------------- 822 REAL(wp) :: zmax, zmin ! temporary scalars 823 INTEGER :: ji,jj ! dummy loop 824 INTEGER :: ii,ij ! temporary scalars 825 INTEGER, DIMENSION(2) :: ilocs ! 826 INTEGER, INTENT( in ) :: kt 827 !! 828 !!========================== 829 !! DIC Check 830 zmax = -5.0 ! arbitrary low maximum value 831 zmin = 4.0E4 ! arbitrary high minimum value 832 DO jj = 2, jpjm1 833 DO ji = 2,jpim1 834 IF( tmask(ji,jj,1) == 1) THEN 835 zmax = MAX(zmax,zdic(ji,jj)) ! find local maximum 836 zmin = MIN(zmin,zdic(ji,jj)) ! find local minimum 837 ENDIF 838 END DO 839 END DO 840 IF( lk_mpp ) CALL mpp_max( zmax ) ! max over the global domain 841 IF( lk_mpp ) CALL mpp_min( zmin ) ! min over the global domain 842 ! 843 IF( zmax .GT. 4.0E3) THEN ! we've got a problem 844 IF (lk_mpp) THEN 845 CALL mpp_maxloc ( zdic(:,:),tmask(:,:,1), zmax, ii,ij ) 846 ELSE 847 ilocs = MAXLOC( zdic(:,:), mask = tmask(:,:,1) == 1. ) 848 ii = ilocs(1) + nimpp - 1 849 ij = ilocs(2) + njmpp - 1 850 ENDIF 851 ! 852 IF(lwp) THEN 853 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** WARNING *****' 854 WRITE(numout,*) 'trc_bio:tracer anomaly: sea surface DIC > 4000 ' 855 WRITE(numout,9600) kt, zmax, ii, ij 856 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** END OF WARNING *****' 857 ENDIF 858 ENDIF 859 ! 860 IF( zmin .LE. 0.0) THEN ! we've got a problem 861 IF (lk_mpp) THEN 862 CALL mpp_minloc ( zdic(:,:),tmask(:,:,1), zmin, ii,ij ) 863 ELSE 864 ilocs = MINLOC( zdic(:,:), mask = tmask(:,:,1) == 1. ) 865 ii = ilocs(1) + nimpp - 1 866 ij = ilocs(2) + njmpp - 1 867 ENDIF 868 ! 869 IF(lwp) THEN 870 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** WARNING *****' 871 WRITE(numout,*) 'trc_bio:tracer anomaly: sea surface DIC <= 0 ' 872 WRITE(numout,9700) kt, zmin, ii, ij 873 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** END OF WARNING *****' 874 ENDIF 875 ENDIF 876 !! 877 !!========================== 878 !! ALKALINITY Check 879 zmax = -5.0 ! arbitrary low maximum value 880 zmin = 4.0E4 ! arbitrary high minimum value 881 DO jj = 2, jpjm1 882 DO ji = 2,jpim1 883 IF( tmask(ji,jj,1) == 1) THEN 884 zmax = MAX(zmax,zalk(ji,jj)) ! find local maximum 885 zmin = MIN(zmin,zalk(ji,jj)) ! find local minimum 886 ENDIF 887 END DO 888 END DO 889 IF( lk_mpp ) CALL mpp_max( zmax ) ! max over the global domain 890 IF( lk_mpp ) CALL mpp_min( zmin ) ! min over the global domain 891 ! 892 IF( zmax .GT. 4.0E3) THEN ! we've got a problem 893 IF (lk_mpp) THEN 894 CALL mpp_maxloc ( zalk(:,:),tmask(:,:,1), zmax, ii,ij ) 895 ELSE 896 ilocs = MAXLOC( zalk(:,:), mask = tmask(:,:,1) == 1. ) 897 ii = ilocs(1) + nimpp - 1 898 ij = ilocs(2) + njmpp - 1 899 ENDIF 900 ! 901 IF(lwp) THEN 902 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** WARNING *****' 903 WRITE(numout,*) 'trc_bio:tracer anomaly: sea surface Alkalinity > 4000 ' 904 WRITE(numout,9800) kt, zmax, ii, ij 905 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** END OF WARNING *****' 906 ENDIF 907 ENDIF 908 ! 909 IF( zmin .LE. 0.0) THEN ! we've got a problem 910 IF (lk_mpp) THEN 911 CALL mpp_minloc ( zalk(:,:),tmask(:,:,1), zmin, ii,ij ) 912 ELSE 913 ilocs = MINLOC( zalk(:,:), mask = tmask(:,:,1) == 1. ) 914 ii = ilocs(1) + nimpp - 1 915 ij = ilocs(2) + njmpp - 1 916 ENDIF 917 ! 918 IF(lwp) THEN 919 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** WARNING *****' 920 WRITE(numout,*) 'trc_bio:tracer anomaly: sea surface Alkalinity <= 0 ' 921 WRITE(numout,9900) kt, zmin, ii, ij 922 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** END OF WARNING *****' 923 ENDIF 924 ENDIF 925 926 927 9600 FORMAT ('trc_bio:tracer anomaly: kt=',i6,' max DIC: ',f16.10,', i j: ',2i5) 928 9700 FORMAT ('trc_bio:tracer anomaly: kt=',i6,' min DIC: ',f16.10,', i j: ',2i5) 929 9800 FORMAT ('trc_bio:tracer anomaly: kt=',i6,' max ALK: ',f16.10,', i j: ',2i5) 930 9900 FORMAT ('trc_bio:tracer anomaly: kt=',i6,' min ALK: ',f16.10,', i j: ',2i5) 931 932 END SUBROUTINE trc_bio_check 933 934 659 935 #else 660 936 !!=====================================================================
Note: See TracChangeset
for help on using the changeset viewer.
