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 8642 – NEMO

Changeset 8642


Ignore:
Timestamp:
2017-10-19T18:10:44+02:00 (7 years ago)
Author:
jpalmier
Message:

jpalm --19-10-17-- Carb failure due to 1-cell exceptionnal and ephemeral T increase - update T passed to MEDUSA and add kill switch

Location:
branches/NERC/dev_r5518_GO6_Carb_Debug/NEMOGCM/NEMO/TOP_SRC
Files:
1 added
6 edited

Legend:

Unmodified
Added
Removed

  • branches/NERC/dev_r5518_GO6_Carb_Debug/NEMOGCM/NEMO/TOP_SRC/MEDUSA/air_sea.F90

    r8521 r8642  
    6262# endif 
    6363                                   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 
    6565# if defined key_iomput 
    6666      USE iom,               ONLY: lk_iomput 
    … …  
    9191      USE trcoxy_medusa,     ONLY: trc_oxy_medusa 
    9292# endif 
     93      USE lib_mpp,           ONLY: ctl_stop 
     94      USE trcstat  
    9395 
    9496   !!* Substitution 
    … …  
    122124 
    123125# 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 
    124141      !!----------------------------------------------------------- 
    125142      !! Air-sea gas exchange 
    … …  
    134151         DO ji = 2,jpim1 
    135152            !! OPEN wet point IF..THEN loop 
    136             if (tmask(ji,jj,1) == 1) then 
     153            IF (tmask(ji,jj,1) == 1) then 
    137154               IF (lk_oasis) THEN 
    138155                  !! use 2D atm xCO2 from atm coupling 
    139156                  f_xco2a(ji,jj) = PCO2a_in_cpl(ji,jj) 
     157                  !!!  
     158                  !!! Jpalm test on atm xCO2 
     159                  IF ( (f_xco2a(ji,jj) > 1000 ).OR.(f_xco2a(ji,jj) < 100 ) ) THEN 
     160                     IF(lwp) 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  
    140164               ENDIF 
    141165               !! 
    … …  
    162186               'air-sea: carb-chem kt = ', kt 
    163187               CALL flush(numout) 
     188               !! JPALM add carb print: 
     189               call trc_rst_dia_stat(f_xco2a(:,:), 'f_xco2a') 
     190               call trc_rst_dia_stat(wndm(:,:), 'wndm') 
     191               call trc_rst_dia_stat(f_kw660(:,:), 'f_kw660') 
     192               call trc_rst_dia_stat(ztmp(:,:), 'ztmp') 
     193               call trc_rst_dia_stat(zsal(:,:), 'zsal') 
     194               call trc_rst_dia_stat(zalk(:,:), 'zalk') 
     195               call trc_rst_dia_stat(zdic(:,:), 'zdic') 
     196               call trc_rst_dia_stat(zsil(:,:), 'zsil') 
     197               call trc_rst_dia_stat(zpho(:,:), 'zpho') 
    164198#   endif 
    165199      DO jj = 2,jpjm1 
    166200         DO ji = 2,jpim1 
    167201            if (tmask(ji,jj,1) == 1) then 
    168                !! air pressure (atm); ultimately this will use air  
    169                !! pressure at the base of the UKESM1 atmosphere  
    170                !!                                      
    171                f_pp0(ji,jj)   = 1.0 
    172                !! 
    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) 
    176202               !! 
    177203#  if defined key_axy_carbchem 
    178204#   if defined key_mocsy 
     205               !! Jpalm -- 12-09-2017 -- add extra check after reccurent 
     206               !!          carbonate failure in the coupled run. 
     207               !!          must be associated to air-sea flux or air xCO2...i 
     208               !!          Check MOCSY inputs 
     209               IF ( (zsal(ji,jj) > 75.0 ).OR.(zsal(ji,jj) < 0.0 ) .OR.     & 
     210                    (ztmp(ji,jj) > 50.0 ).OR.(ztmp(ji,jj) < -20.0 ) .OR.     & 
     211                    (zalk(ji,jj) > 35.0E2 ).OR.(zalk(ji,jj) <= 0.0 ) .OR.     & 
     212                    (zdic(ji,jj) > 35.0E2 ).OR.(zdic(ji,jj) <= 0.0 ) .OR.     & 
     213                    (f_kw660(ji,jj) > 1.0E-2 ).OR.(f_kw660(ji,jj) < 0.0 ) ) THEN 
     214                  IF(lwp) THEN  
     215                      WRITE(numout,*) ' surface T = ',ztmp(ji,jj) 
     216                      WRITE(numout,*) ' surface S = ',zsal(ji,jj) 
     217                      WRITE(numout,*) ' surface ALK = ',zalk(ji,jj) 
     218                      WRITE(numout,*) ' surface DIC = ',zdic(ji,jj) 
     219                      WRITE(numout,*) ' KW660 = ',f_kw660(ji,jj) 
     220                      WRITE(numout,*) ' atm xCO2 = ',f_xco2a(ji,jj)    
     221                      WRITE(numout,*) ' surface pco2w  = ',f_pco2w(ji,jj) 
     222                      WRITE(numout,*) ' surface fco2w  = ',f_fco2w(ji,jj) 
     223                      WRITE(numout,*) ' surface fco2a  = ',f_fco2atm(ji,jj) 
     224                      WRITE(numout,*) ' surface co2flx = ',f_co2flux(ji,jj) 
     225                      WRITE(numout,*) ' surface dpco2  = ',f_dpco2(ji,jj) 
     226                      WRITE(numout,*) ' MOCSY input: ji =', mig(ji),' jj = ', mjg(jj),  & 
     227                                       ' kt = ', kt  
     228                      WRITE(numout,*) 'MEDUSA - Air-Sea : unrealistic surface Carb. Chemistry' 
     229                      CALL ctl_stop( 'MEDUSA - Air-Sea :', 'unrealistic surface Carb. Chemistry -- INPUTS' ) 
     230                  ENDIF      
     231               ENDIF      
    179232               !! 
    180233               !! AXY (22/06/15): use Orr & Epitalon (2015) MOCSY-2 carbonate 
    … …  
    201254               f_TALK(ji,jj) = (zalk(ji,jj) / f_rhosw(ji,jj)) * 1000. 
    202255               f_dcf(ji,jj)  = f_rhosw(ji,jj) 
     256               !! Jpalm -- 12-09-2017 -- add extra check after reccurent 
     257               !!          carbonate failure in the coupled run. 
     258               !!          must be associated to air-sea flux or air xCO2...i 
     259               !!          Check MOCSY inputs 
     260              IF ( (f_pco2w(ji,jj) > 1.E4 ).OR.(f_pco2w(ji,jj) < 0.0 ) .OR.     & 
     261                   (f_fco2w(ji,jj) > 1.E4 ).OR.(f_fco2w(ji,jj) < 0.0 ) .OR.     &    
     262                   (f_fco2atm(ji,jj) > 1.E4 ).OR.(f_fco2atm(ji,jj) < 0.0 ) .OR.     & 
     263                   (f_co2flux(ji,jj) > 1.E-2 ).OR.(f_co2flux(ji,jj) < -1.E-2 ) .OR.     & 
     264                   (f_dpco2(ji,jj) > 1.E4 ).OR.(f_dpco2(ji,jj) < -1.E4 ) ) THEN 
     265                 IF(lwp) THEN  
     266                     WRITE(numout,*) ' surface T = ',ztmp(ji,jj) 
     267                     WRITE(numout,*) ' surface S = ',zsal(ji,jj) 
     268                     WRITE(numout,*) ' surface ALK = ',zalk(ji,jj) 
     269                     WRITE(numout,*) ' surface DIC = ',zdic(ji,jj) 
     270                     WRITE(numout,*) ' KW660 = ',f_kw660(ji,jj) 
     271                     WRITE(numout,*) ' atm xCO2 = ',f_xco2a(ji,jj)    
     272                     WRITE(numout,*) ' surface pco2w  = ',f_pco2w(ji,jj) 
     273                     WRITE(numout,*) ' surface fco2w  = ',f_fco2w(ji,jj) 
     274                     WRITE(numout,*) ' surface fco2a  = ',f_fco2atm(ji,jj) 
     275                     WRITE(numout,*) ' surface co2flx = ',f_co2flux(ji,jj) 
     276                     WRITE(numout,*) ' surface dpco2  = ',f_dpco2(ji,jj) 
     277                     WRITE(numout,*) ' MOCSY output: ji =', mig(ji),' jj = ', mjg(jj),  & 
     278                                       ' kt = ', kt      
     279                     WRITE(numout,*) 'MEDUSA - Air-Sea : unrealistic surface Carb. Chemistry' 
     280                     CALL ctl_stop( 'MEDUSA - Air-Sea :', 'unrealistic surface Carb. Chemistry -- OUTPUTS' ) 
     281                 ENDIF      
     282              ENDIF      
    203283            ENDIF 
    204284         ENDDO 
    205285      ENDDO 
    206286 
     287#   if defined key_debug_medusa 
     288               !! JPALM add carb print: 
     289               call trc_rst_dia_stat(f_pco2w(:,:), 'f_pco2w') 
     290               call trc_rst_dia_stat(f_fco2w(:,:), 'f_fco2w') 
     291               call trc_rst_dia_stat(f_fco2atm(:,:), 'f_fco2atm') 
     292               call trc_rst_dia_stat(f_schmidtco2(:,:), 'f_schmidtco2') 
     293               call trc_rst_dia_stat(f_kwco2(:,:), 'f_kwco2') 
     294               call trc_rst_dia_stat(f_co2starair(:,:), 'f_co2starair') 
     295               call trc_rst_dia_stat(f_co2flux(:,:), 'f_co2flux') 
     296               call trc_rst_dia_stat(f_dpco2(:,:), 'f_dpco2') 
     297#   endif 
    207298#   else    
    208299 

  • branches/NERC/dev_r5518_GO6_Carb_Debug/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_init.F90

    r8521 r8642  
    173173      fslowsinkc(:,:) = 0.0 
    174174# endif       
     175      !! 
     176      !! JPALM -- 21-09-2017 -- needed to debug air-sea carb 
     177      f_xco2a(:,:)  = 0.0 
     178      f_pco2w(:,:)  = 0.0 
     179      f_ph(:,:)     = 0.0 
     180      f_kw660(:,:)  = 0.0 
     181      ztmp(:,:)  = 0.0 
     182      zsal(:,:)  = 0.0 
     183      zalk(:,:)  = 0.0 
     184      zdic(:,:)  = 0.0 
     185      zsil(:,:)  = 0.0 
     186      zpho(:,:)  = 0.0 
     187      f_co2flux(:,:)  = 0.0  
     188      f_pco2atm(:,:)  = 0.0 
     189      f_h2co3(:,:)    = 0.0 
     190      f_hco3(:,:)     = 0.0 
     191      f_co3(:,:)      = 0.0 
     192      f_omarg(:,:)    = 0.0 
     193      f_omcal(:,:)    = 0.0 
    175194      !! 
    176195      !! allocate and initiate 2D diag 

  • branches/NERC/dev_r5518_GO6_Carb_Debug/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90

    r8442 r8642  
    177177      !! temporary variables 
    178178      REAL(wp) ::    fq0,fq1,fq2,fq3,fq4 
     179      !! 
     180      !! T and S check temporary variable 
     181      REAL(wp) ::    sumtsn, tsnavg 
     182      INTEGER  ::    summask 
    179183      !! 
    180184      !!------------------------------------------------------------------ 
    … …  
    474478                  if (ztmp(ji,jj) .lt. -3.0 .or. ztmp(ji,jj) .gt. 40.0 ) then 
    475479                     IF(lwp) WRITE(numout,*)                                 & 
    476                         ' trc_bio_medusa: T WARNING 2D, ',                   & 
     480                        ' trc_bio_medusa: T WARNING 3D, ',                   & 
    477481                        tsb(ji,jj,jk,jp_tem), tsn(ji,jj,jk,jp_tem),          & 
    478482                        ' 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                     !! temperature 
    483484                     ztmp(ji,jj) = tsb(ji,jj,jk,jp_tem) 
     485                      IF(lwp) WRITE(numout,*)                                 & 
     486                     ' trc_bio_medusa: Abnormal T suroundings Temp' 
     487                      IF(lwp) WRITE(numout,*)                                 & 
     488                     tsn(ji-1,jj+1,jk,jp_tem), tsn(ji,jj+1,jk,jp_tem), tsn(ji+1,jj+1,jk,jp_tem) 
     489                      IF(lwp) WRITE(numout,*)                                 & 
     490                     tsn(ji-1,jj,jk,jp_tem), tsn(ji,jj,jk,jp_tem), tsn(ji+1,jj,jk,jp_tem) 
     491                      IF(lwp) WRITE(numout,*)                                 & 
     492                     tsn(ji-1,jj-1,jk,jp_tem), tsn(ji,jj-1,jk,jp_tem), tsn(ji+1,jj-1,jk,jp_tem) 
     493                     sumtsn = ( tmask(ji-1,jj+1,jk) * tsn(ji-1,jj+1,jk,jp_tem) ) + &  
     494                              ( tmask(ji  ,jj+1,jk) * tsn(ji  ,jj+1,jk,jp_tem) ) + &  
     495                              ( tmask(ji+1,jj+1,jk) * tsn(ji+1,jj+1,jk,jp_tem) ) + &  
     496                              ( tmask(ji-1,jj  ,jk) * tsn(ji-1,jj  ,jk,jp_tem) ) + &  
     497                              ( tmask(ji+1,jj  ,jk) * tsn(ji+1,jj  ,jk,jp_tem) ) + &  
     498                              ( tmask(ji-1,jj-1,jk) * tsn(ji-1,jj-1,jk,jp_tem) ) + &  
     499                              ( tmask(ji  ,jj-1,jk) * tsn(ji  ,jj-1,jk,jp_tem) ) + &  
     500                              ( tmask(ji+1,jj-1,jk) * tsn(ji+1,jj-1,jk,jp_tem) ) 
     501                      IF(lwp) WRITE(numout,*)                                 & 
     502                     ' trc_bio_medusa: Abnormal T suroundings Sal' 
     503                      IF(lwp) WRITE(numout,*)                                 & 
     504                     tsn(ji-1,jj+1,jk,jp_sal), tsn(ji,jj+1,jk,jp_sal), tsn(ji+1,jj+1,jk,jp_sal) 
     505                      IF(lwp) WRITE(numout,*)                                 & 
     506                     tsn(ji-1,jj,jk,jp_sal), tsn(ji,jj,jk,jp_sal), tsn(ji+1,jj,jk,jp_sal) 
     507                      IF(lwp) WRITE(numout,*)                                 & 
     508                     tsn(ji-1,jj-1,jk,jp_sal), tsn(ji,jj-1,jk,jp_sal), tsn(ji+1,jj-1,jk,jp_sal) 
     509                     !! 
     510                      IF(lwp) WRITE(numout,*)                                 & 
     511                     ' trc_bio_medusa: Abnormal T suroundings DIC' 
     512                      IF(lwp) WRITE(numout,*)                                 & 
     513                     trn(ji-1,jj+1,jk,jpdic), trn(ji,jj+1,jk,jpdic), trn(ji+1,jj+1,jk,jpdic) 
     514                      IF(lwp) WRITE(numout,*)                                 & 
     515                     trn(ji-1,jj,jk,jpdic), trn(ji,jj,jk,jpdic), trn(ji+1,jj,jk,jpdic) 
     516                      IF(lwp) WRITE(numout,*)                                 & 
     517                     trn(ji-1,jj-1,jk,jpdic), trn(ji,jj-1,jk,jpdic), trn(ji+1,jj-1,jk,jpdic) 
     518                      IF(lwp) WRITE(numout,*)                                 & 
     519                     ' trc_bio_medusa: Abnormal T suroundings Alk' 
     520                      IF(lwp) WRITE(numout,*)                                 & 
     521                     trn(ji-1,jj+1,jk,jpalk), trn(ji,jj+1,jk,jpalk), trn(ji+1,jj+1,jk,jpalk) 
     522                      IF(lwp) WRITE(numout,*)                                 & 
     523                     trn(ji-1,jj,jk,jpalk), trn(ji,jj,jk,jpalk), trn(ji+1,jj,jk,jpalk) 
     524                      IF(lwp) WRITE(numout,*)                                 & 
     525                     trn(ji-1,jj-1,jk,jpalk), trn(ji,jj-1,jk,jpalk), trn(ji+1,jj-1,jk,jpalk) 
     526                      IF(lwp) WRITE(numout,*)                                 & 
     527                     ' trc_bio_medusa: Abnormal T suroundings tmask' 
     528                      IF(lwp) WRITE(numout,*)                                 & 
     529                     tmask(ji-1,jj+1,jk), tmask(ji,jj+1,jk), tmask(ji+1,jj+1,jk) 
     530                      IF(lwp) WRITE(numout,*)                                 & 
     531                     tmask(ji-1,jj,jk), tmask(ji,jj,jk), tmask(ji+1,jj,jk) 
     532                      IF(lwp) WRITE(numout,*)                                 & 
     533                     tmask(ji-1,jj-1,jk), tmask(ji,jj-1,jk), tmask(ji+1,jj-1,jk) 
     534                     summask = tmask(ji-1,jj+1,jk) + tmask(ji  ,jj+1,jk)   +  & 
     535                               tmask(ji+1,jj+1,jk) + tmask(ji-1,jj  ,jk)   +  & 
     536                               tmask(ji+1,jj  ,jk) + tmask(ji-1,jj-1,jk)   +  &  
     537                               tmask(ji  ,jj-1,jk) + tmask(ji+1,jj-1,jk)  
     538                     tsnavg = ( sumtsn / summask ) 
     539                     !! Correct out of range values 
     540                     IF ( ( summask .EQ. 0.0 ) .OR. (tsnavg .LT. -3.0 ) .OR.   & 
     541                          ( tsnavg .GT. 40.0 ) ) THEN     
     542                        IF (ztmp(ji,jj) .LT. -3.0 ) THEN 
     543                           IF(lwp) WRITE(numout,*)                           & 
     544                           ' trc_bio_medusa: T SWITCHING 3D, ',              & 
     545                           tsn(ji,jj,jk,jp_tem), ' -> -3.0 ' 
     546                           ztmp(ji,jj) = -3.0 
     547                        ENDIF 
     548                        IF (ztmp(ji,jj) .GT. 40.0 ) THEN 
     549                           IF(lwp) WRITE(numout,*)                           & 
     550                           ' trc_bio_medusa: T SWITCHING 3D, ',              & 
     551                           tsn(ji,jj,jk,jp_tem), ' -> 40.0 ' 
     552                           ztmp(ji,jj) = 40.0 
     553                        ENDIF 
     554                     ELSE  
     555                        IF(lwp) WRITE(numout,*)                              & 
     556                        ' trc_bio_medusa: T SWITCHING 3D, ',                 & 
     557                        tsn(ji,jj,jk,jp_tem), ' -> surounding avg : ', tsnavg 
     558                        ztmp(ji,jj) = tsnavg 
     559                     ENDIF 
    484560                  endif 
    485                   if (zsal(ji,jj) .lt. 0.0 .or. zsal(ji,jj) .gt. 45.0 ) then 
     561                  !! end T chack 
     562                  if (zsal(ji,jj) .lt. 1.0 .or. zsal(ji,jj) .gt. 47.0 ) then 
    486563                     IF(lwp) WRITE(numout,*)                                 & 
    487564                        ' trc_bio_medusa: S WARNING 2D, ',                   & 
    488565                        tsb(ji,jj,jk,jp_sal), tsn(ji,jj,jk,jp_sal),          & 
    489566                        ' at (', ji, ',', jj, ',', jk, ') at time', kt 
     567                     !! Correct out of range values 
     568                     IF (zsal(ji,jj) .LT. 1.0 ) THEN 
     569                        IF(lwp) WRITE(numout,*)                              & 
     570                        ' trc_bio_medusa: S SWITCHING 3D, ',                 & 
     571                        tsn(ji,jj,jk,jp_sal), ' -> 1.0 ' 
     572                        zsal(ji,jj) = 1.0 
     573                     ENDIF 
     574                     IF (zsal(ji,jj) .GT. 47.0 ) THEN 
     575                        IF(lwp) WRITE(numout,*)                              & 
     576                        ' trc_bio_medusa: T SWITCHING 3D, ',                 & 
     577                        tsn(ji,jj,jk,jp_sal), ' -> 47.0 ' 
     578                        zsal(ji,jj) = 47.0 
     579                     ENDIF 
    490580                  endif 
     581                  !! end S check 
    491582               ENDIF 
    492583            ENDDO 

  • branches/NERC/dev_r5518_GO6_Carb_Debug/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r8442 r8642  
    2828   USE zpshde          ! partial step: hor. derivative       (zps_hde routine) 
    2929# if defined key_debug_medusa 
    30    USE trcrst 
     30   USE trcstat 
    3131# endif 
    3232 

  • branches/NERC/dev_r5518_GO6_Carb_Debug/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r8427 r8642  
    4343   USE sbc_oce, ONLY: lk_oasis  
    4444   USE oce,     ONLY: CO2Flux_out_cpl, DMS_out_cpl, chloro_out_cpl  !! Coupling variable 
     45   USE trcstat 
    4546 
    4647   IMPLICIT NONE 
    … …  
    5253   PUBLIC   trc_rst_cal 
    5354   PUBLIC   trc_rst_stat 
    54    PUBLIC   trc_rst_dia_stat 
    55    PUBLIC   trc_rst_tra_stat 
    5655 
    5756   !! * Substitutions 
    … …  
    697696 
    698697 
    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       CHARACTER (LEN=18) :: text_zmean 
    748       REAL(wp) :: ztraf, zmin, zmax, zmean, areasf 
    749       REAL(wp), DIMENSION(jpi,jpj) :: zvol 
    750       !!---------------------------------------------------------------------- 
    751  
    752       IF( lwp )  WRITE(numout,*) 'STAT- ', names 
    753        
    754       ! fse3t_a will be undefined at the start of a run, but this routine 
    755       ! may be called at any stage! Hence we MUST make sure it is  
    756       ! initialised to zero when allocated to enable us to test for  
    757       ! zero content here and avoid potentially dangerous and non-portable  
    758       ! 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 ) THEN 
    766          CALL mpp_min( zmin )      ! min over the global domain 
    767          CALL mpp_max( zmax )      ! max over the global domain 
    768       END IF 
    769  
    770       text_zmean = "N/A" 
    771       ! Avoid divide by zero. areasf must be positive. 
    772       IF  (areasf > 0.0) THEN  
    773          zmean = ztraf / areasf 
    774          WRITE(text_zmean,'(e18.10)') zmean 
    775       ENDIF 
    776  
    777       IF(lwp) WRITE(numout,9002) TRIM( names ), text_zmean, zmin, zmax 
    778  
    779   9002  FORMAT(' tracer name :',A,'    mean :',A,'    min :',e18.10, & 
    780       &      '    max :',e18.10 ) 
    781       ! 
    782    END SUBROUTINE trc_rst_dia_stat 
    783  
    784  
    785698#else 
    786699   !!---------------------------------------------------------------------- 

  • branches/NERC/dev_r5518_GO6_Carb_Debug/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r8442 r8642  
    1919   USE trcwri 
    2020   USE trcrst 
     21   USE trcstat 
    2122   USE trdtrc_oce 
    2223   USE trdmxl_trc 
Note: See TracChangeset for help on using the changeset viewer.