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 5708 for branches/UKMO – NEMO

Changeset 5708 for branches/UKMO


Ignore:
Timestamp:
2015-08-26T14:49:08+02:00 (9 years ago)
Author:
davestorkey
Message:

Commit changes for icesheet freshwater input code for coupled models without an active icesheet model.

Location:
branches/UKMO/dev_r5518_coupling_GSI7_GSI8_landice/NEMOGCM
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_coupling_GSI7_GSI8_landice/NEMOGCM/CONFIG/SHARED/field_def.xml

    r5517 r5708  
    193193 
    194194         <!-- * variable related to ice shelf forcing * --> 
     195         <field id="berg_calve"   long_name="Iceberg calving"                               unit="kg/m2/s"  /> 
    195196         <field id="fwfisf"       long_name="Ice shelf melting"                             unit="kg/m2/s"  /> 
    196197         <field id="qisf"         long_name="Ice Shelf Heat Flux"                           unit="W/m2"     /> 
  • branches/UKMO/dev_r5518_coupling_GSI7_GSI8_landice/NEMOGCM/CONFIG/SHARED/namelist_ref

    r5501 r5708  
    378378   ln_usecplmask = .false.   !  use a coupling mask file to merge data received from several models 
    379379                             !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
     380   ln_coupled_iceshelf_fluxes = .false. ! If true use rate of change of mass of Greenland and Antarctic icesheets to set the  
     381                                        ! combined magnitude of the iceberg calving and iceshelf melting freshwater fluxes. 
     382   rn_greenland_calving_fraction = 0.5  ! Set fraction of total freshwater flux for iceberg calving - remainder goes to iceshelf melting. 
     383   rn_antarctica_calving_fraction = 0.5 ! Set fraction of total freshwater flux for iceberg calving - remainder goes to iceshelf melting. 
     384   rn_iceshelf_fluxes_tolerance = 1e-6  ! Fractional threshold for detecting differences in icesheet masses (must be positive definite). 
    380385/ 
    381386!----------------------------------------------------------------------- 
  • branches/UKMO/dev_r5518_coupling_GSI7_GSI8_landice/NEMOGCM/NEMO/OPA_SRC/ICB/icbclv.F90

    r5662 r5708  
    2525   USE icbutl         ! iceberg utility routines 
    2626 
     27   USE sbc_oce        ! for icesheet freshwater input variables 
     28   USE in_out_manager 
     29   USE iom 
     30 
    2731   IMPLICIT NONE 
    2832   PRIVATE 
     
    4852      ! 
    4953      REAL(wp)                        :: zcalving_used, zdist, zfact 
     54      REAL(wp)                        :: zgreenland_calving_sum, zantarctica_calving_sum 
    5055      INTEGER                         :: jn, ji, jj                    ! loop counters 
    5156      INTEGER                         :: imx                           ! temporary integer for max berg class 
     
    5964      zfact = ( (1000._wp)**3 / ( NINT(rday) * nyear_len(1) ) ) * 850._wp 
    6065      berg_grid%calving(:,:) = src_calving(:,:) * tmask_i(:,:) * zfact 
     66 
     67      IF( lk_oasis) THEN 
     68      ! ln_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 
     69      IF( ln_coupled_iceshelf_fluxes ) THEN 
     70 
     71        ! Adjust total calving rates so that sum of iceberg calving and iceshelf melting in the northern 
     72        ! and southern hemispheres equals rate of increase of mass of greenland and antarctic ice sheets 
     73        ! to preserve total freshwater conservation in coupled models without an active ice sheet model. 
     74 
     75         zgreenland_calving_sum = SUM( berg_grid%calving(:,:) * greenland_icesheet_mask(:,:) ) 
     76         IF( lk_mpp ) CALL mpp_sum( zgreenland_calving_sum ) 
     77         WHERE( greenland_icesheet_mask(:,:) == 1.0 )                                                                                 & 
     78        &    berg_grid%calving(:,:) = berg_grid%calving(:,:) * greenland_icesheet_mass_rate_of_change * rn_greenland_calving_fraction & 
     79        &                                     / ( zgreenland_calving_sum + 1.0e-10_wp ) 
     80 
     81         ! check 
     82         WRITE(numout, *) 'Greenland iceberg calving climatology (kg/s) : ',zgreenland_calving_sum 
     83         zgreenland_calving_sum = SUM( berg_grid%calving(:,:) * greenland_icesheet_mask(:,:) ) 
     84         IF( lk_mpp ) CALL mpp_sum( zgreenland_calving_sum ) 
     85         WRITE(numout, *) 'Greenland iceberg calving adjusted value (kg/s) : ',zgreenland_calving_sum 
     86 
     87         zantarctica_calving_sum = SUM( berg_grid%calving(:,:) * antarctica_icesheet_mask(:,:) ) 
     88         IF( lk_mpp ) CALL mpp_sum( zantarctica_calving_sum ) 
     89         WHERE( antarctica_icesheet_mask(:,:) == 1.0 )                                                                              & 
     90         berg_grid%calving(:,:) = berg_grid%calving(:,:) * antarctica_icesheet_mass_rate_of_change * rn_antarctica_calving_fraction & 
     91        &                           / ( zantarctica_calving_sum + 1.0e-10_wp ) 
     92  
     93         ! check 
     94         WRITE(numout, *) 'Antarctica iceberg calving climatology (kg/s) : ',zantarctica_calving_sum 
     95         zantarctica_calving_sum = SUM( berg_grid%calving(:,:) * antarctica_icesheet_mask(:,:) ) 
     96         IF( lk_mpp ) CALL mpp_sum( zantarctica_calving_sum ) 
     97         WRITE(numout, *) 'Antarctica iceberg calving adjusted value (kg/s) : ',zantarctica_calving_sum 
     98 
     99      ENDIF 
     100      ENDIF 
     101    
     102      CALL iom_put( 'berg_calve', berg_grid%calving(:,:) ) 
    61103 
    62104      ! Heat in units of W/m2, and mask (just in case) 
  • branches/UKMO/dev_r5518_coupling_GSI7_GSI8_landice/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r5662 r5708  
    2424   USE trdmxl_oce      ! ocean active mixed layer tracers trends variables 
    2525   USE divcur          ! hor. divergence and curl      (div & cur routines) 
     26   USE sbc_oce         ! for icesheet freshwater input variables 
    2627 
    2728   IMPLICIT NONE 
     
    145146                     CALL iom_rstput( kt, nitrst, numrow, 'rhd'    , rhd       ) 
    146147#endif 
     148                     IF( lk_oasis) THEN 
     149                     ! ln_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 
     150                     IF( ln_coupled_iceshelf_fluxes ) THEN 
     151                        CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_mass', greenland_icesheet_mass ) 
     152                        CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_timelapsed', greenland_icesheet_timelapsed ) 
     153                        CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_mass_roc', greenland_icesheet_mass_rate_of_change ) 
     154                        CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_mass', antarctica_icesheet_mass ) 
     155                        CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_timelapsed', antarctica_icesheet_timelapsed ) 
     156                        CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_mass_roc', antarctica_icesheet_mass_rate_of_change ) 
     157                     ENDIF 
     158                     ENDIF 
     159 
    147160      IF( kt == nitrst ) THEN 
    148161         CALL iom_close( numrow )     ! close the restart file (only at last time step) 
     
    258271#endif 
    259272      ! 
     273      IF( iom_varid( numror, 'greenland_icesheet_mass', ldstop = .FALSE. ) > 0 )   THEN 
     274         CALL iom_get( numror, 'greenland_icesheet_mass', greenland_icesheet_mass ) 
     275         CALL iom_get( numror, 'greenland_icesheet_timelapsed', greenland_icesheet_timelapsed ) 
     276         CALL iom_get( numror, 'greenland_icesheet_mass_roc', greenland_icesheet_mass_rate_of_change ) 
     277      ELSE 
     278         greenland_icesheet_mass = 0.0  
     279         greenland_icesheet_mass_rate_of_change = 0.0  
     280         greenland_icesheet_timelapsed = 0.0 
     281      ENDIF 
     282      IF( iom_varid( numror, 'antarctica_icesheet_mass', ldstop = .FALSE. ) > 0 )   THEN 
     283         CALL iom_get( numror, 'antarctica_icesheet_mass', antarctica_icesheet_mass ) 
     284         CALL iom_get( numror, 'antarctica_icesheet_timelapsed', antarctica_icesheet_timelapsed ) 
     285         CALL iom_get( numror, 'antarctica_icesheet_mass_roc', antarctica_icesheet_mass_rate_of_change ) 
     286      ELSE 
     287         antarctica_icesheet_mass = 0.0  
     288         antarctica_icesheet_mass_rate_of_change = 0.0  
     289         antarctica_icesheet_timelapsed = 0.0 
     290      ENDIF 
     291 
    260292      IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0) 
    261293         tsb  (:,:,:,:) = tsn  (:,:,:,:)                             ! all before fields set to now values 
  • branches/UKMO/dev_r5518_coupling_GSI7_GSI8_landice/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r5678 r5708  
    125125#endif 
    126126   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask          !: coupling mask for ln_mixcpl (warning: allocated in sbccpl) 
    127    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   greenland_mass_array 
    128    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   antarctica_mass_array 
     127   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   greenland_icesheet_mass_array, greenland_icesheet_mask 
     128   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   antarctica_icesheet_mass_array, antarctica_icesheet_mask 
    129129 
    130130   !!---------------------------------------------------------------------- 
     
    148148   !!---------------------------------------------------------------------- 
    149149    
    150    REAL, PUBLIC  :: greenland_mass 
    151    REAL, PUBLIC  :: antarctica_mass 
     150   REAL(wp), PUBLIC  :: greenland_icesheet_mass, greenland_icesheet_mass_rate_of_change, greenland_icesheet_timelapsed  
     151   REAL(wp), PUBLIC  :: antarctica_icesheet_mass, antarctica_icesheet_mass_rate_of_change, antarctica_icesheet_timelapsed 
     152 
     153   ! sbccpl namelist parameters associated with icesheet freshwater input code. Included here rather than in sbccpl.F90 to  
     154   ! avoid circular dependencies. 
     155   LOGICAL, PUBLIC     ::   ln_coupled_iceshelf_fluxes     ! If true use rate of change of mass of Greenland and Antarctic icesheets to set the  
     156                                                           ! combined magnitude of the iceberg calving and iceshelf melting freshwater fluxes. 
     157   REAL(wp), PUBLIC    ::   rn_greenland_calving_fraction  ! Set fraction of total freshwater flux for iceberg calving - remainder goes to iceshelf melting. 
     158   REAL(wp), PUBLIC    ::   rn_antarctica_calving_fraction ! Set fraction of total freshwater flux for iceberg calving - remainder goes to iceshelf melting. 
     159   REAL(wp), PUBLIC    ::   rn_iceshelf_fluxes_tolerance   ! Fractional threshold for detecting differences in icesheet masses.  
    152160 
    153161   !! * Substitutions 
     
    185193         &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) ,      & 
    186194         &      ssv_m  (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) ) 
    187       ALLOCATE( greenland_mass_array(jpi,jpj) , antarctica_mass_array(jpi,jpj) ) 
     195      ALLOCATE( greenland_icesheet_mass_array(jpi,jpj) , antarctica_icesheet_mass_array(jpi,jpj) ) 
     196      ALLOCATE( greenland_icesheet_mask(jpi,jpj) , antarctica_icesheet_mask(jpi,jpj) ) 
    188197         ! 
    189198#if defined key_vvl 
  • branches/UKMO/dev_r5518_coupling_GSI7_GSI8_landice/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r5680 r5708  
    227227         &                  sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf   , sn_rcv_cal   , sn_rcv_iceflx,  & 
    228228         &                  sn_rcv_co2 , sn_rcv_grnm  , sn_rcv_antm  , sn_rcv_ts_ice, nn_cplmodel  ,  & 
    229          &                  ln_usecplmask 
     229         &                  ln_usecplmask, ln_coupled_iceshelf_fluxes, rn_greenland_calving_fraction, & 
     230         &                  rn_antarctica_calving_fraction, rn_iceshelf_fluxes_tolerance 
    230231      !!--------------------------------------------------------------------- 
    231232      ! 
     
    285286         WRITE(numout,*)'  nn_cplmodel                         = ', nn_cplmodel 
    286287         WRITE(numout,*)'  ln_usecplmask                       = ', ln_usecplmask 
     288         WRITE(numout,*)'  ln_coupled_iceshelf_fluxes          = ', ln_coupled_iceshelf_fluxes 
     289         WRITE(numout,*)'  rn_greenland_calving_fraction       = ', rn_greenland_calving_fraction 
     290         WRITE(numout,*)'  rn_antarctica_calving_fraction      = ', rn_antarctica_calving_fraction 
     291         WRITE(numout,*)'  rn_iceshelf_fluxes_tolerance        = ', rn_iceshelf_fluxes_tolerance 
    287292      ENDIF 
    288293 
     
    892897      ncpl_qsr_freq = 86400 / ncpl_qsr_freq 
    893898 
     899      IF( ln_coupled_iceshelf_fluxes ) THEN 
     900          ! Crude masks to separate the Antarctic and Greenland icesheets. Obviously something 
     901          ! more complicated could be done if required. 
     902          greenland_icesheet_mask = 0.0 
     903          WHERE( gphit >= 0.0 ) greenland_icesheet_mask = 1.0 
     904          antarctica_icesheet_mask = 0.0 
     905          WHERE( gphit < 0.0 ) antarctica_icesheet_mask = 1.0 
     906 
     907          ! initialise other variables 
     908          greenland_icesheet_mass_array(:,:) = 0.0 
     909          antarctica_icesheet_mass_array(:,:) = 0.0 
     910 
     911          IF( .not. ln_rstart ) THEN 
     912             greenland_icesheet_mass = 0.0  
     913             greenland_icesheet_mass_rate_of_change = 0.0  
     914             greenland_icesheet_timelapsed = 0.0 
     915             antarctica_icesheet_mass = 0.0  
     916             antarctica_icesheet_mass_rate_of_change = 0.0  
     917             antarctica_icesheet_timelapsed = 0.0 
     918          ENDIF 
     919 
     920      ENDIF 
     921 
    894922      CALL wrk_dealloc( jpi,jpj, zacs, zaos ) 
    895923      ! 
     
    953981      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdttra did not change since nit000) 
    954982      REAL(wp) ::   zcumulneg, zcumulpos   ! temporary scalars      
     983      REAL(wp) ::   zgreenland_icesheet_mass_in, zantarctica_icesheet_mass_in 
     984      REAL(wp) ::   zgreenland_icesheet_mass_b, zantarctica_icesheet_mass_b 
     985      REAL(wp) ::   zmask_sum, zepsilon       
    955986      REAL(wp) ::   zcoef                  ! temporary scalar 
    956987      REAL(wp) ::   zrhoa  = 1.22          ! Air density kg/m3 
     
    12371268      ENDIF 
    12381269       
    1239       !                                                        ! land ice masses 
    1240       IF( srcv(jpr_grnm)%laction )   greenland_mass_array(:,:) = frcv(jpr_grnm)%z3(:,:,1) 
    1241       IF( srcv(jpr_antm)%laction )   antarctica_mass_array(:,:) = frcv(jpr_antm)%z3(:,:,1) 
    1242       greenland_mass = greenland_mass_array(1,1) 
    1243       antarctica_mass = antarctica_mass_array(1,1) 
    1244           
    1245       WRITE(numout,*) 'Greenland mass is ', greenland_mass 
    1246       WRITE(numout,*) 'Antarctica mass is ', antarctica_mass 
     1270      !                                                        ! land ice masses : Greenland 
     1271      zepsilon = rn_iceshelf_fluxes_tolerance 
     1272 
     1273      IF( srcv(jpr_grnm)%laction ) THEN 
     1274         greenland_icesheet_mass_array(:,:) = frcv(jpr_grnm)%z3(:,:,1) 
     1275         ! take average over ocean points of input array to avoid cumulative error over time 
     1276         zgreenland_icesheet_mass_in = SUM( greenland_icesheet_mass_array(:,:) * tmask(:,:,1) ) 
     1277         IF(lk_mpp) CALL mpp_sum( zgreenland_icesheet_mass_in ) 
     1278         zmask_sum = SUM( tmask(:,:,1) ) 
     1279         IF(lk_mpp) CALL mpp_sum( zmask_sum )  
     1280         zgreenland_icesheet_mass_in = zgreenland_icesheet_mass_in / zmask_sum 
     1281         greenland_icesheet_timelapsed = greenland_icesheet_timelapsed + rdt          
     1282         IF( ABS( zgreenland_icesheet_mass_in - greenland_icesheet_mass )/( greenland_icesheet_mass + zepsilon ) > zepsilon ) THEN 
     1283            zgreenland_icesheet_mass_b = greenland_icesheet_mass 
     1284            greenland_icesheet_mass = zgreenland_icesheet_mass_in 
     1285            IF( zgreenland_icesheet_mass_b /= 0.0 ) & 
     1286           &     greenland_icesheet_mass_rate_of_change = ( greenland_icesheet_mass - zgreenland_icesheet_mass_b ) / greenland_icesheet_timelapsed  
     1287            greenland_icesheet_timelapsed = 0.0_wp        
     1288         ENDIF 
     1289         IF(lwp) WRITE(numout,*) 'Greenland icesheet mass (kg) is ', greenland_icesheet_mass 
     1290         IF(lwp) WRITE(numout,*) 'Greenland icesheet mass rate of change (kg/s) is ', greenland_icesheet_mass_rate_of_change 
     1291         IF(lwp) WRITE(numout,*) 'Greenland icesheet seconds lapsed since last change is ', greenland_icesheet_timelapsed 
     1292      ENDIF 
     1293 
     1294      !                                                        ! land ice masses : Antarctica 
     1295      IF( srcv(jpr_antm)%laction ) THEN 
     1296         antarctica_icesheet_mass_array(:,:) = frcv(jpr_antm)%z3(:,:,1) 
     1297         ! take average over ocean points of input array to avoid cumulative error from rounding errors over time 
     1298         zantarctica_icesheet_mass_in = SUM( antarctica_icesheet_mass_array(:,:) * tmask(:,:,1) ) 
     1299         IF(lk_mpp) CALL mpp_sum( zantarctica_icesheet_mass_in ) 
     1300         zmask_sum = SUM( tmask(:,:,1) ) 
     1301         IF(lk_mpp) CALL mpp_sum( zmask_sum )  
     1302         zantarctica_icesheet_mass_in = zantarctica_icesheet_mass_in / zmask_sum 
     1303         antarctica_icesheet_timelapsed = antarctica_icesheet_timelapsed + rdt          
     1304         IF( ABS( zantarctica_icesheet_mass_in - antarctica_icesheet_mass )/( antarctica_icesheet_mass + zepsilon ) > zepsilon ) THEN 
     1305            zantarctica_icesheet_mass_b = antarctica_icesheet_mass 
     1306            antarctica_icesheet_mass = zantarctica_icesheet_mass_in 
     1307            IF( zantarctica_icesheet_mass_b /= 0.0 ) & 
     1308          &      antarctica_icesheet_mass_rate_of_change = ( antarctica_icesheet_mass - zantarctica_icesheet_mass_b ) / antarctica_icesheet_timelapsed  
     1309            antarctica_icesheet_timelapsed = 0.0_wp        
     1310         ENDIF 
     1311         IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass (kg) is ', antarctica_icesheet_mass 
     1312         IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass rate of change (kg/s) is ', antarctica_icesheet_mass_rate_of_change 
     1313         IF(lwp) WRITE(numout,*) 'Antarctica icesheet seconds lapsed since last change is ', antarctica_icesheet_timelapsed 
     1314      ENDIF 
     1315 
    12471316      ! 
    12481317      CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 
  • branches/UKMO/dev_r5518_coupling_GSI7_GSI8_landice/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90

    r5662 r5708  
    2727   USE fldread         ! read input field at current time step 
    2828 
    29  
    30  
    3129   IMPLICIT NONE 
    3230   PRIVATE 
     
    9088    INTEGER                      ::   ji, jj, jk, ijkmin, inum, ierror 
    9189    INTEGER                      ::   ikt, ikb   ! top and bottom level of the isf boundary layer 
     90    REAL(wp)                     ::   zgreenland_fwfisf_sum, zantarctica_fwfisf_sum 
    9291    REAL(wp)                     ::   rmin 
    9392    REAL(wp)                     ::   zhk 
     
    256255            CALL fld_read ( kt, nn_fsbc, sf_rnfisf   ) 
    257256            fwfisf(:,:) = - sf_rnfisf(1)%fnow(:,:,1)         ! fresh water flux from the isf (fwfisf <0 mean melting)  
     257 
     258            IF( lk_oasis) THEN 
     259            ! ln_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 
     260            IF( ln_coupled_iceshelf_fluxes ) THEN 
     261 
     262              ! Adjust total iceshelf melt rates so that sum of iceberg calving and iceshelf melting in the northern 
     263              ! and southern hemispheres equals rate of increase of mass of greenland and antarctic ice sheets 
     264              ! to preserve total freshwater conservation in coupled models without an active ice sheet model. 
     265 
     266               zgreenland_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * greenland_icesheet_mask(:,:) ) 
     267               IF( lk_mpp ) CALL mpp_sum( zgreenland_fwfisf_sum ) 
     268               ! use ABS function because we need to preserve the sign of fwfisf 
     269               WHERE( greenland_icesheet_mask(:,:) == 1.0 )                                                                  & 
     270              &    fwfisf(:,:) = fwfisf(:,:)  * ABS( greenland_icesheet_mass_rate_of_change * (1.0-rn_greenland_calving_fraction) & 
     271              &                           / ( zgreenland_fwfisf_sum + 1.0e-10_wp ) ) 
     272 
     273               ! check 
     274               WRITE(numout, *) 'Greenland iceshelf melting climatology (kg/s) : ',zgreenland_fwfisf_sum 
     275               zgreenland_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * greenland_icesheet_mask(:,:) ) 
     276               IF( lk_mpp ) CALL mpp_sum( zgreenland_fwfisf_sum ) 
     277               WRITE(numout, *) 'Greenland iceshelf melting adjusted value (kg/s) : ',zgreenland_fwfisf_sum 
     278 
     279               zantarctica_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * antarctica_icesheet_mask(:,:) ) 
     280               IF( lk_mpp ) CALL mpp_sum( zantarctica_fwfisf_sum ) 
     281               ! use ABS function because we need to preserve the sign of fwfisf 
     282               WHERE( antarctica_icesheet_mask(:,:) == 1.0 ) & 
     283              &    fwfisf(:,:) = fwfisf(:,:)  * ABS( antarctica_icesheet_mass_rate_of_change * (1.0-rn_antarctica_calving_fraction) & 
     284              &                           / ( zantarctica_fwfisf_sum + 1.0e-10_wp ) ) 
     285       
     286               ! check 
     287               WRITE(numout, *) 'Antarctica iceshelf melting climatology (kg/s) : ',zantarctica_fwfisf_sum 
     288               zantarctica_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * antarctica_icesheet_mask(:,:) ) 
     289               IF( lk_mpp ) CALL mpp_sum( zantarctica_fwfisf_sum ) 
     290               WRITE(numout, *) 'Antarctica iceshelf melting adjusted value (kg/s) : ',zantarctica_fwfisf_sum 
     291 
     292            ENDIF 
     293            ENDIF 
     294 
    258295            qisf(:,:)   = fwfisf(:,:) * lfusisf              ! heat        flux 
    259296            stbl(:,:)   = soce 
     
    264301            !CALL fld_read ( kt, nn_fsbc, sf_qisf   ) 
    265302            fwfisf(:,:) = sf_fwfisf(1)%fnow(:,:,1)            ! fwf 
     303 
     304            IF( lk_oasis) THEN 
     305            ! ln_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 
     306            IF( ln_coupled_iceshelf_fluxes ) THEN 
     307 
     308              ! Adjust total iceshelf melt rates so that sum of iceberg calving and iceshelf melting in the northern 
     309              ! and southern hemispheres equals rate of increase of mass of greenland and antarctic ice sheets 
     310              ! to preserve total freshwater conservation in coupled models without an active ice sheet model. 
     311 
     312               zgreenland_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * greenland_icesheet_mask(:,:) ) 
     313               IF( lk_mpp ) CALL mpp_sum( zgreenland_fwfisf_sum ) 
     314               ! use ABS function because we need to preserve the sign of fwfisf 
     315               WHERE( greenland_icesheet_mask(:,:) == 1.0 )                                                                  & 
     316              &    fwfisf(:,:) = fwfisf(:,:)  * ABS( greenland_icesheet_mass_rate_of_change * (1.0-rn_greenland_calving_fraction) & 
     317              &                           / ( zgreenland_fwfisf_sum + 1.0e-10_wp ) ) 
     318 
     319               ! check 
     320               WRITE(numout, *) 'Greenland iceshelf melting climatology (kg/s) : ',zgreenland_fwfisf_sum 
     321               zgreenland_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * greenland_icesheet_mask(:,:) ) 
     322               IF( lk_mpp ) CALL mpp_sum( zgreenland_fwfisf_sum ) 
     323               WRITE(numout, *) 'Greenland iceshelf melting adjusted value (kg/s) : ',zgreenland_fwfisf_sum 
     324 
     325               zantarctica_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * antarctica_icesheet_mask(:,:) ) 
     326               IF( lk_mpp ) CALL mpp_sum( zantarctica_fwfisf_sum ) 
     327               ! use ABS function because we need to preserve the sign of fwfisf 
     328               WHERE( antarctica_icesheet_mask(:,:) == 1.0 ) & 
     329              &    fwfisf(:,:) = fwfisf(:,:)  * ABS( antarctica_icesheet_mass_rate_of_change * (1.0-rn_antarctica_calving_fraction) & 
     330              &                           / ( zantarctica_fwfisf_sum + 1.0e-10_wp ) ) 
     331       
     332               ! check 
     333               WRITE(numout, *) 'Antarctica iceshelf melting climatology (kg/s) : ',zantarctica_fwfisf_sum 
     334               zantarctica_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * antarctica_icesheet_mask(:,:) ) 
     335               IF( lk_mpp ) CALL mpp_sum( zantarctica_fwfisf_sum ) 
     336               WRITE(numout, *) 'Antarctica iceshelf melting adjusted value (kg/s) : ',zantarctica_fwfisf_sum 
     337 
     338            ENDIF 
     339            ENDIF 
     340 
    266341            qisf(:,:)   = fwfisf(:,:) * lfusisf              ! heat        flux 
    267342            !qisf(:,:)   = sf_qisf(1)%fnow(:,:,1)              ! heat flux 
Note: See TracChangeset for help on using the changeset viewer.