Ignore:
Timestamp:
2018-01-18T11:14:03+01:00 (3 years ago)
Author:
frrh
Message:

Commit JP's Met Office GMED ticket 371 for trapping or notifying of
peculiar values of MEDUSA fields arising from transient temperature
spikes in the ocean.

Committed using:
svn merge: 9177:9249 svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/NERC/dev_r5518_GO6_Carb_Fail_from_GO6_9163

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90

    r8442 r9257  
    2323   !!  -   !  2016-11  (A. Yool)              Updated diags for CMIP6 
    2424   !!  -   !  2017-05  (A. Yool)              Added extra DMS calculation 
     25   !!  -   !  2017-11  (J. Palm, A. Yool)     Diagnose tracer excursions 
    2526   !!---------------------------------------------------------------------- 
    2627   !! 
     
    8182                                            gdepw_0, gdepw_n,               & 
    8283                                            nday_year, nsec_day, nyear,     & 
    83                                             rdt, tmask 
     84                                            rdt, tmask, mig, mjg, nimpp,    & 
     85                                            njmpp  
    8486      USE in_out_manager,             ONLY: lwp, numout, nn_date0 
    8587# if defined key_iomput 
     
    8789# endif 
    8890      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   
    9094      USE oce,                        ONLY: tsb, tsn 
    9195      USE par_kind,                   ONLY: wp 
     
    115119       
    116120      PUBLIC   trc_bio_medusa    ! called in trcsms_medusa.F90 
     121      PUBLIC   trc_bio_exceptionnal_fix ! here  
    117122 
    118123   !!* Substitution 
     
    177182      !! temporary variables 
    178183      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 
    179189      !! 
    180190      !!------------------------------------------------------------------ 
     
    450460 
    451461# if defined key_roam 
     462         !! extra MEDUSA-2 tracers 
    452463         DO jj = 2,jpjm1 
    453464            DO ji = 2,jpim1 
     
    456467                  zdtc(ji,jj) = max(0.,trn(ji,jj,jk,jpdtc)) 
    457468                  !! dissolved inorganic carbon 
    458                   zdic(ji,jj) = max(0.,trn(ji,jj,jk,jpdic)) 
     469                  zdic(ji,jj) = trn(ji,jj,jk,jpdic) 
    459470                  !! alkalinity 
    460                   zalk(ji,jj) = max(0.,trn(ji,jj,jk,jpalk)) 
     471                  zalk(ji,jj) = trn(ji,jj,jk,jpalk) 
    461472                  !! oxygen 
    462473                  zoxy(ji,jj) = max(0.,trn(ji,jj,jk,jpoxy)) 
     
    470481                  ztmp(ji,jj) = tsn(ji,jj,jk,jp_tem) 
    471482                  zsal(ji,jj) = tsn(ji,jj,jk,jp_sal) 
    472                   !! 
    473              !! AXY (28/02/14): check input fields 
    474                   if (ztmp(ji,jj) .lt. -3.0 .or. ztmp(ji,jj) .gt. 40.0 ) then 
    475                      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', kt 
    479            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                      !! temperatur 
    483                      ztmp(ji,jj) = tsb(ji,jj,jk,jp_tem) 
    484                   endif 
    485                   if (zsal(ji,jj) .lt. 0.0 .or. zsal(ji,jj) .gt. 45.0 ) then 
    486                      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', kt 
    490                   endif 
    491483               ENDIF 
    492484            ENDDO 
    493485         ENDDO 
    494486# else 
     487         !! diagnostic MEDUSA-1 detrital carbon tracer 
    495488         DO jj = 2,jpjm1 
    496489            DO ji = 2,jpim1 
    497                if (tmask(ji,jj,jk) == 1) then 
     490               IF (tmask(ji,jj,jk) == 1) THEN 
    498491                  !! implicit detrital carbon 
    499492                  zdtc(ji,jj) = zdet(ji,jj) * xthetad 
     
    502495         ENDDO 
    503496# 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 
    504568# if defined key_debug_medusa 
    505569         DO jj = 2,jpjm1 
     
    657721   END SUBROUTINE trc_bio_medusa 
    658722 
     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 
     8079100  FORMAT('Row:', i1, '  ', e16.6, ' ', e16.6, ' ', e16.6) 
     8089200  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 
     9279600  FORMAT ('trc_bio:tracer anomaly: kt=',i6,' max DIC: ',f16.10,', i j: ',2i5) 
     9289700  FORMAT ('trc_bio:tracer anomaly: kt=',i6,' min DIC: ',f16.10,', i j: ',2i5) 
     9299800  FORMAT ('trc_bio:tracer anomaly: kt=',i6,' max ALK: ',f16.10,', i j: ',2i5) 
     9309900  FORMAT ('trc_bio:tracer anomaly: kt=',i6,' min ALK: ',f16.10,', i j: ',2i5) 
     931 
     932   END SUBROUTINE trc_bio_check 
     933 
     934 
    659935#else 
    660936   !!===================================================================== 
Note: See TracChangeset for help on using the changeset viewer.