New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 9245 for branches/NERC/dev_r5518_GO6_Carb_Fail_from_GO6_9163/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90 – NEMO

Ignore:
Timestamp:
2018-01-16T16:57:50+01:00 (6 years ago)
Author:
jpalmier
Message:

JPALM -- GMED-371 -- corrections after Richard's review -

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/NERC/dev_r5518_GO6_Carb_Fail_from_GO6_9163/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90

    r9182 r9245  
    8989# endif 
    9090      USE lbclnk,                     ONLY: lbc_lnk 
    91       USE lib_mpp   
     91      USE lib_mpp,                    ONLY: mpp_max, mpp_maxloc,  
     92                                            mpp_min, mpp_minloc,            & 
     93                                            ctl_stop, ctl_warn  
    9294      USE oce,                        ONLY: tsb, tsn 
    9395      USE par_kind,                   ONLY: wp 
     
    117119       
    118120      PUBLIC   trc_bio_medusa    ! called in trcsms_medusa.F90 
    119       PUBLIC   trc_bio_exceptional_fix ! here  
     121      PUBLIC   trc_bio_exceptionnal_fix ! here  
    120122 
    121123   !!* Substitution 
     
    497499         !! --------------------------------------------- 
    498500         !! JPALM -- 14-12-2017 -- Here, before any exeptionnal crazy value is 
    499          !!              removed, we want to tell to the Master Node that this  
     501         !!              removed, we want to tell to the Master Processor that this  
    500502         !!              Exceptionnal value did exist 
    501503         !! 
     
    514516         !! ocean.output file; the error reporting below is strictly local 
    515517         !! to the relevant ocean.output_XXXX file so will not be visible 
    516          !! unless all nodes are reporting output 
     518         !! unless all processors are reporting output 
    517519         !!================================================================ 
    518520         !! 
     
    527529                     !! 
    528530                     !! 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) ) 
     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 
    537541                     !! 
    538542                     !! Detect, report and correct tracer excursions 
    539543                     IF ( (ztmp(ji,jj) .LT. -3.0) .OR. (ztmp(ji,jj) .GT.  40.0) )             & 
    540                         CALL trc_bio_exceptional_fix(                                         & 
     544                        CALL trc_bio_exceptionnal_fix(                                         & 
    541545                        tsn(ji-1:ji+1,jj-1:jj+1,jk,jp_tem), tmask(ji-1:ji+1,jj-1:jj+1,jk),    & 
    542546                        'Tmp', -3.0, 40.0, ztmp(ji,jj) ) 
    543547                     !! 
    544548                     IF ( (zsal(ji,jj) .LE. 0.0) .OR. (zsal(ji,jj) .GT.  50.0)  )             & 
    545                         CALL trc_bio_exceptional_fix(                                         & 
     549                        CALL trc_bio_exceptionnal_fix(                                         & 
    546550                        tsn(ji-1:ji+1,jj-1:jj+1,jk,jp_sal), tmask(ji-1:ji+1,jj-1:jj+1,jk),    & 
    547551                        'Sal', 1.0, 50.0, zsal(ji,jj) ) 
    548552                     !! 
    549553                     IF ( (zdic(ji,jj) .LE. 0.0) .OR. (zdic(ji,jj) .GT. 4.0E3)  )             & 
    550                         CALL trc_bio_exceptional_fix(                                         & 
     554                        CALL trc_bio_exceptionnal_fix(                                         & 
    551555                        trn(ji-1:ji+1,jj-1:jj+1,jk,jpdic), tmask(ji-1:ji+1,jj-1:jj+1,jk),     & 
    552556                        'DIC', 100.0, 4.0E3, zdic(ji,jj) ) 
    553557                     !! 
    554558                     IF ( (zalk(ji,jj) .LE. 0.0) .OR. (zalk(ji,jj) .GT. 4.0E3)  )             & 
    555                         CALL trc_bio_exceptional_fix(                                         & 
     559                        CALL trc_bio_exceptionnal_fix(                                         & 
    556560                        trn(ji-1:ji+1,jj-1:jj+1,jk,jpalk), tmask(ji-1:ji+1,jj-1:jj+1,jk),     & 
    557561                        'Alk', 100.0, 4.0E3, zalk(ji,jj) ) 
     
    719723 
    720724 
    721    SUBROUTINE trc_bio_exceptional_fix(tiny_var, tiny_mask, var_nm, mini, maxi, varout) 
     725   SUBROUTINE trc_bio_exceptionnal_fix(tiny_var, tiny_mask, var_nm, mini, maxi, varout) 
    722726      !! JPALM (27/10/17): This function is called only when abnormal values that  
    723727      !! could break the model's carbonate system are fed to MEDUSA 
     
    745749      !! Print surounding values to check if isolated Crazy value or  
    746750      !! 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  
     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 
    766771      !! Correct out of range values 
    767772      sumtsn = ( tiny_mask(ii-1,ij+1) * tiny_var(ii-1,ij+1) ) +  & 
     
    787792      ENDIF 
    788793      !! 
    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          ' ' 
     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,*) ' ' 
    8008059100  FORMAT('Row:', i1, '  ', e16.6, ' ', e16.6, ' ', e16.6) 
    8018069200  FORMAT(e16.6) 
    802807 
    803    END SUBROUTINE trc_bio_exceptional_fix  
     808   END SUBROUTINE trc_bio_exceptionnal_fix  
    804809 
    805810   SUBROUTINE trc_bio_check(kt) 
     
    808813      !!                     problem. The model is now able to correct a local 
    809814      !!                     crazy value. but does it silently. 
    810       !!                     We need to spread the word to the master node. we 
     815      !!                     We need to spread the word to the master processor. we 
    811816      !!                     don't want the model  to correct values without telling us 
    812817      !!                     This module will tell at least when crazy DIC or 
Note: See TracChangeset for help on using the changeset viewer.