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 10302 for branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/air_sea.F90 – NEMO

Ignore:
Timestamp:
2018-11-13T18:21:16+01:00 (5 years ago)
Author:
dford
Message:

Merge in revisions 8447:10159 of dev_r5518_GO6_package.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/air_sea.F90

    r8442 r10302  
    66   !! History : 
    77   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90 
     8   !!   -   ! 2017-08 (A. Yool)            Add air-sea flux kill switch 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_medusa 
     
    6162# endif 
    6263                                   zchd, zchn, zdin, zsil 
    63       USE dom_oce,           ONLY: e3t_0, e3t_n, gphit, tmask 
    64 # if defined key_iomput 
     64      USE dom_oce,           ONLY: e3t_0, gphit, tmask, mig, mjg 
     65# if defined key_vvl 
     66      USE dom_oce,           ONLY: e3t_n 
     67# endif 
    6568      USE iom,               ONLY: lk_iomput 
    66 # endif 
    6769      USE in_out_manager,    ONLY: lwp, numout 
    68       USE oce,               ONLY: PCO2a_in_cpl 
    6970      USE par_kind,          ONLY: wp 
    7071      USE par_oce,           ONLY: jpi, jpim1, jpj, jpjm1 
    71       USE sbc_oce,           ONLY: fr_i, lk_oasis, qsr, wndm 
     72      USE sbc_oce,           ONLY: fr_i, qsr, wndm 
    7273      USE sms_medusa,        ONLY: jdms, jdms_input, jdms_model,          & 
    7374                                   jriver_alk, jriver_c,                  & 
    7475                                   jriver_n, jriver_si,                   & 
     76                                   ln_foam_medusa,                        & 
    7577                                   riv_alk, riv_c, riv_n, riv_si,         & 
    7678                                   zn_dms_chd, zn_dms_chn, zn_dms_din,    & 
    7779                                   zn_dms_mld, zn_dms_qsr,                & 
     80                                   f2_pco2w, f2_fco2w,                    & 
    7881                                   xnln, xnld  
    7982      USE trc,               ONLY: med_diag 
     
    8689#  else 
    8790      USE trcco2_medusa,     ONLY: trc_co2_medusa 
     91      USE mocsy_mainmod,     ONLY: p2fCO2 
    8892#  endif 
    8993      USE trcdms_medusa,     ONLY: trc_dms_medusa 
    9094      USE trcoxy_medusa,     ONLY: trc_oxy_medusa 
    9195# endif 
     96      USE lib_mpp,           ONLY: ctl_stop 
     97      USE trcstat,           ONLY: trc_rst_dia_stat  
    9298 
    9399   !!* Substitution 
     
    121127 
    122128# if defined key_roam 
     129      !! init 
     130      f_fco2w(:,:)       = 0.0 
     131      f_fco2atm(:,:)     = 0.0 
     132      f_schmidtco2(:,:)  = 0.0 
     133      f_kwco2(:,:)       = 0.0 
     134      f_co2starair(:,:)  = 0.0 
     135      f_dpco2(:,:)       = 0.0 
     136      f_rhosw(:,:)       = 0.0 
     137      f_K0(:,:)          = 0.0 
     138      !! air pressure (atm); ultimately this will use air  
     139      !! pressure at the base of the UKESM1 atmosphere  
     140      !!                                      
     141      f_pp0(:,:)   = 1.0 
     142 
     143 
    123144      !!----------------------------------------------------------- 
    124145      !! Air-sea gas exchange 
     
    133154         DO ji = 2,jpim1 
    134155            !! OPEN wet point IF..THEN loop 
    135             if (tmask(ji,jj,1) == 1) then 
    136                IF (lk_oasis) THEN 
    137                   !! use 2D atm xCO2 from atm coupling 
    138                   f_xco2a(ji,jj) = PCO2a_in_cpl(ji,jj) 
    139                ENDIF 
     156            IF (tmask(ji,jj,1) == 1) then 
    140157               !! 
    141158               !! AXY (23/06/15): as part of an effort to update the  
     
    161178               'air-sea: carb-chem kt = ', kt 
    162179               CALL flush(numout) 
     180               !! JPALM add carb print: 
     181               call trc_rst_dia_stat(f_xco2a(:,:), 'f_xco2a') 
     182               call trc_rst_dia_stat(wndm(:,:), 'wndm') 
     183               call trc_rst_dia_stat(f_kw660(:,:), 'f_kw660') 
     184               call trc_rst_dia_stat(ztmp(:,:), 'ztmp') 
     185               call trc_rst_dia_stat(zsal(:,:), 'zsal') 
     186               call trc_rst_dia_stat(zalk(:,:), 'zalk') 
     187               call trc_rst_dia_stat(zdic(:,:), 'zdic') 
     188               call trc_rst_dia_stat(zsil(:,:), 'zsil') 
     189               call trc_rst_dia_stat(zpho(:,:), 'zpho') 
    163190#   endif 
     191#  if defined key_axy_carbchem 
     192#   if defined key_mocsy 
    164193      DO jj = 2,jpjm1 
    165194         DO ji = 2,jpim1 
    166195            if (tmask(ji,jj,1) == 1) then 
    167                !! air pressure (atm); ultimately this will use air  
    168                !! pressure at the base of the UKESM1 atmosphere  
    169                !!                                      
    170                f_pp0(ji,jj)   = 1.0 
    171                !! 
    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                !! 
    176 #  if defined key_axy_carbchem 
    177 #   if defined key_mocsy 
     196               !! 
     197               !! Jpalm -- 12-09-2017 -- add extra check after reccurent 
     198               !!          carbonate failure in the coupled run. 
     199               !!          must be associated to air-sea flux or air xCO2... 
     200               !!          Check MOCSY inputs 
     201               IF ( (zsal(ji,jj) > 75.0 ).OR.(zsal(ji,jj) < 0.0 ) .OR.        & 
     202                    (ztmp(ji,jj) > 50.0 ).OR.(ztmp(ji,jj) < -20.0 ) .OR.      & 
     203                    (zalk(ji,jj) > 35.0E2 ).OR.(zalk(ji,jj) <= 0.0 ) .OR.     & 
     204                    (zdic(ji,jj) > 35.0E2 ).OR.(zdic(ji,jj) <= 0.0 ) .OR.     & 
     205                    (f_kw660(ji,jj) > 1.0E-2 ).OR.(f_kw660(ji,jj) < 0.0 ) ) THEN 
     206                  IF(lwp) THEN  
     207                      WRITE(numout,*) ' surface T = ',ztmp(ji,jj) 
     208                      WRITE(numout,*) ' surface S = ',zsal(ji,jj) 
     209                      WRITE(numout,*) ' surface ALK = ',zalk(ji,jj) 
     210                      WRITE(numout,*) ' surface DIC = ',zdic(ji,jj) 
     211                      WRITE(numout,*) ' KW660 = ',f_kw660(ji,jj) 
     212                      WRITE(numout,*) ' atm xCO2 = ',f_xco2a(ji,jj)    
     213                      WRITE(numout,*) ' surface pco2w  = ',f_pco2w(ji,jj) 
     214                      WRITE(numout,*) ' surface fco2w  = ',f_fco2w(ji,jj) 
     215                      WRITE(numout,*) ' surface fco2a  = ',f_fco2atm(ji,jj) 
     216                      WRITE(numout,*) ' surface co2flx = ',f_co2flux(ji,jj) 
     217                      WRITE(numout,*) ' surface dpco2  = ',f_dpco2(ji,jj) 
     218                      WRITE(numout,*) ' MOCSY input: ji =', mig(ji),' jj = ', mjg(jj),  & 
     219                                       ' kt = ', kt  
     220                      WRITE(numout,*) 'MEDUSA - Air-Sea INPUT: unrealistic surface Carb. Chemistry' 
     221                  ENDIF      
     222                  CALL ctl_stop( 'MEDUSA - Air-Sea INPUT: ',             & 
     223                                 'unrealistic surface Carb. Chemistry -- INPUTS' ) 
     224               ENDIF      
    178225               !! 
    179226               !! AXY (22/06/15): use Orr & Epitalon (2015) MOCSY-2 carbonate 
     
    200247               f_TALK(ji,jj) = (zalk(ji,jj) / f_rhosw(ji,jj)) * 1000. 
    201248               f_dcf(ji,jj)  = f_rhosw(ji,jj) 
     249               !! Jpalm -- 12-09-2017 -- add extra check after reccurent 
     250               !!          carbonate failure in the coupled run. 
     251               !!          must be associated to air-sea flux or air xCO2... 
     252               !!          Check MOCSY outputs 
     253               !!=================== 
     254               !! Jpalm -- 19-02-2018 -- remove the cap - only check MOCSY inputs 
     255               !!       because of specific area in arabic sea where strangely 
     256               !!       with core 2 forcing, ALK is lower than DIC and result in  
     257               !!       Enormous dpco2 - even if all carb chem caract are OK. 
     258               !!       and this check stops the model. 
     259               !!       --Input checks are already more than enough to stop the 
     260               !!       model if carb chem goes crazy.  
     261               !!       we remove the mocsy output checks 
     262               !!=================== 
     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-1 ).OR.(f_co2flux(ji,jj) < -1.E-1 ) .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      
    202287            ENDIF 
    203288         ENDDO 
    204289      ENDDO 
    205290 
     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 
    206302#   else    
    207303 
     
    234330                     iters, ' AT (', ji, ', ', jj, ', 1) AT ', kt 
    235331               endif 
     332               IF ( ln_foam_medusa ) THEN 
     333                  !! DAF (Aug 2017): calculate fCO2 for observation operator 
     334                  CALL p2fCO2( f_pco2w, ztmp, f_pp0, 0.0, 1, f_fco2w ) 
     335               ENDIF 
    236336            ENDIF 
    237337         ENDDO 
     
    277377         ENDDO 
    278378      ENDDO 
     379#  endif 
     380 
     381#  if defined key_axy_killco2flux 
     382      !! AXY (18/08/17): single kill switch on air-sea CO2 flux for budget checking 
     383      f_co2flux(:,:) = 0. 
    279384#  endif 
    280385 
     
    408513                              CO2flux_conv 
    409514               !! ENDIF 
     515               IF ( ln_foam_medusa ) THEN 
     516                  !! DAF (Aug 2017): Save pCO2 and fCO2 for observation operator 
     517                  f2_pco2w(ji,jj) = f_pco2w(ji,jj) 
     518                  f2_fco2w(ji,jj) = f_pco2w(ji,jj) 
     519               ENDIF 
    410520               IF ( lk_iomput ) THEN 
    411521                  IF( med_diag%ATM_PCO2%dgsave ) THEN 
Note: See TracChangeset for help on using the changeset viewer.