- Timestamp:
- 2018-06-21T11:58:42+02:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_nemo2cice_prints/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r9816 r9817 33 33 USE cpl_oasis3 ! OASIS3 coupling 34 34 USE geo2ocean ! 35 USE oce , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev 35 USE oce , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev, & 36 CO2Flux_out_cpl, DMS_out_cpl, chloro_out_cpl, & 37 PCO2a_in_cpl, Dust_in_cpl, & 38 ln_medusa 36 39 USE albedo ! 37 40 USE in_out_manager ! I/O manager … … 46 49 USE p4zflx, ONLY : oce_co2 47 50 #endif 48 #if defined key_cice49 USE ice_domain_size, only: ncat50 #endif51 51 #if defined key_lim3 52 52 USE limthd_dh ! for CALL lim_thd_snwblow 53 53 #endif 54 USE lib_fortran, ONLY: glob_sum 54 55 55 56 IMPLICIT NONE … … 105 106 INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness 106 107 INTEGER, PARAMETER :: jpr_fraqsr = 42 ! fraction of solar net radiation absorbed in the first ocean level 107 INTEGER, PARAMETER :: jprcv = 42 ! total number of fields received 108 INTEGER, PARAMETER :: jpr_ts_ice = 43 ! skin temperature of sea-ice (used for melt-ponds) 109 INTEGER, PARAMETER :: jpr_grnm = 44 ! Greenland ice mass 110 INTEGER, PARAMETER :: jpr_antm = 45 ! Antarctic ice mass 111 INTEGER, PARAMETER :: jpr_atm_pco2 = 46 ! Incoming atm CO2 flux 112 INTEGER, PARAMETER :: jpr_atm_dust = 47 ! Incoming atm aggregate dust 113 INTEGER, PARAMETER :: jprcv = 47 ! total number of fields received 108 114 109 115 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere … … 135 141 INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl) 136 142 INTEGER, PARAMETER :: jps_fraqsr = 28 ! fraction of solar net radiation absorbed in the first ocean level 137 INTEGER, PARAMETER :: jpsnd = 28 ! total number of fields sended 143 INTEGER, PARAMETER :: jps_a_p = 29 ! meltpond fraction 144 INTEGER, PARAMETER :: jps_ht_p = 30 ! meltpond depth (m) 145 INTEGER, PARAMETER :: jps_kice = 31 ! ice surface layer thermal conductivity 146 INTEGER, PARAMETER :: jps_sstfrz = 32 ! sea-surface freezing temperature 147 INTEGER, PARAMETER :: jps_fice1 = 33 ! first-order ice concentration (for time-travelling ice coupling) 148 INTEGER, PARAMETER :: jps_bio_co2 = 34 ! MEDUSA air-sea CO2 flux 149 INTEGER, PARAMETER :: jps_bio_dms = 35 ! MEDUSA DMS surface concentration 150 INTEGER, PARAMETER :: jps_bio_chloro = 36 ! MEDUSA chlorophyll surface concentration 151 INTEGER, PARAMETER :: jpsnd = 36 ! total number of fields sent 152 153 REAL(wp), PARAMETER :: dms_unit_conv = 1.0e+6 ! Coversion factor to get outgong DMS in standard units for coupling 154 ! i.e. specifically nmol/L (= umol/m3) 138 155 139 156 ! !!** namelist namsbc_cpl ** … … 146 163 END TYPE FLD_C 147 164 ! Send to the atmosphere ! 148 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2 165 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2, sn_snd_cond, sn_snd_mpnd, sn_snd_sstfrz, sn_snd_thick1 166 TYPE(FLD_C) :: sn_snd_bio_co2, sn_snd_bio_dms, sn_snd_bio_chloro 167 149 168 ! Received from the atmosphere ! 150 169 TYPE(FLD_C) :: sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 151 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2 170 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_ts_ice, sn_rcv_grnm, sn_rcv_antm 171 TYPE(FLD_C) :: sn_rcv_atm_pco2, sn_rcv_atm_dust 172 152 173 ! Other namelist parameters ! 153 174 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data … … 188 209 ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 189 210 #endif 190 ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 211 !ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 212 ! Hardwire only two models as nn_cplmodel has not been read in 213 ! from the namelist yet. 214 ALLOCATE( xcplmask(jpi,jpj,0:2) , STAT=ierr(3) ) 191 215 ! 192 216 sbc_cpl_alloc = MAXVAL( ierr ) … … 216 240 REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos 217 241 !! 218 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, & 219 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 220 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx, & 221 & sn_rcv_co2 , nn_cplmodel , ln_usecplmask 242 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick , sn_snd_crt , sn_snd_co2, & 243 & sn_snd_cond, sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1, & 244 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 245 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx, & 246 & sn_rcv_co2 , sn_rcv_grnm , sn_rcv_antm , sn_rcv_ts_ice, nn_cplmodel , & 247 & ln_usecplmask, nn_coupled_iceshelf_fluxes, ln_iceshelf_init_atmos, & 248 & rn_greenland_total_fw_flux, rn_greenland_calving_fraction, & 249 & rn_antarctica_total_fw_flux, rn_antarctica_calving_fraction, rn_iceshelf_fluxes_tolerance 222 250 !!--------------------------------------------------------------------- 251 252 ! Add MEDUSA related fields to namelist 253 NAMELIST/namsbc_cpl/ sn_snd_bio_co2, sn_snd_bio_dms, sn_snd_bio_chloro, & 254 & sn_rcv_atm_pco2, sn_rcv_atm_dust 255 256 !!--------------------------------------------------------------------- 257 223 258 ! 224 259 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_init') … … 245 280 ENDIF 246 281 IF( lwp .AND. ln_cpl ) THEN ! control print 247 WRITE(numout,*)' received fields (mutiple ice catego gies)'282 WRITE(numout,*)' received fields (mutiple ice categories)' 248 283 WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')' 249 284 WRITE(numout,*)' stress module = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')' … … 258 293 WRITE(numout,*)' runoffs = ', TRIM(sn_rcv_rnf%cldes ), ' (', TRIM(sn_rcv_rnf%clcat ), ')' 259 294 WRITE(numout,*)' calving = ', TRIM(sn_rcv_cal%cldes ), ' (', TRIM(sn_rcv_cal%clcat ), ')' 295 WRITE(numout,*)' Greenland ice mass = ', TRIM(sn_rcv_grnm%cldes ), ' (', TRIM(sn_rcv_grnm%clcat ), ')' 296 WRITE(numout,*)' Antarctica ice mass = ', TRIM(sn_rcv_antm%cldes ), ' (', TRIM(sn_rcv_antm%clcat ), ')' 260 297 WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 261 298 WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')' 299 WRITE(numout,*)' atm pco2 = ', TRIM(sn_rcv_atm_pco2%cldes), ' (', TRIM(sn_rcv_atm_pco2%clcat), ')' 300 WRITE(numout,*)' atm dust = ', TRIM(sn_rcv_atm_dust%cldes), ' (', TRIM(sn_rcv_atm_dust%clcat), ')' 262 301 WRITE(numout,*)' sent fields (multiple ice categories)' 263 302 WRITE(numout,*)' surface temperature = ', TRIM(sn_snd_temp%cldes ), ' (', TRIM(sn_snd_temp%clcat ), ')' … … 268 307 WRITE(numout,*)' - orientation = ', sn_snd_crt%clvor 269 308 WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd 309 WRITE(numout,*)' bio co2 flux = ', TRIM(sn_snd_bio_co2%cldes), ' (', TRIM(sn_snd_bio_co2%clcat), ')' 310 WRITE(numout,*)' bio dms flux = ', TRIM(sn_snd_bio_dms%cldes), ' (', TRIM(sn_snd_bio_dms%clcat), ')' 311 WRITE(numout,*)' bio dms chlorophyll = ', TRIM(sn_snd_bio_chloro%cldes), ' (', TRIM(sn_snd_bio_chloro%clcat), ')' 270 312 WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')' 313 WRITE(numout,*)' ice effective conductivity = ', TRIM(sn_snd_cond%cldes ), ' (', TRIM(sn_snd_cond%clcat ), ')' 314 WRITE(numout,*)' meltponds fraction & depth = ', TRIM(sn_snd_mpnd%cldes ), ' (', TRIM(sn_snd_mpnd%clcat ), ')' 315 WRITE(numout,*)' sea surface freezing temp = ', TRIM(sn_snd_sstfrz%cldes ), ' (', TRIM(sn_snd_sstfrz%clcat ), ')' 316 271 317 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel 272 318 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask 319 WRITE(numout,*)' nn_coupled_iceshelf_fluxes = ', nn_coupled_iceshelf_fluxes 320 WRITE(numout,*)' ln_iceshelf_init_atmos = ', ln_iceshelf_init_atmos 321 WRITE(numout,*)' rn_greenland_total_fw_flux = ', rn_greenland_total_fw_flux 322 WRITE(numout,*)' rn_antarctica_total_fw_flux = ', rn_antarctica_total_fw_flux 323 WRITE(numout,*)' rn_greenland_calving_fraction = ', rn_greenland_calving_fraction 324 WRITE(numout,*)' rn_antarctica_calving_fraction = ', rn_antarctica_calving_fraction 325 WRITE(numout,*)' rn_iceshelf_fluxes_tolerance = ', rn_iceshelf_fluxes_tolerance 273 326 ENDIF 274 327 275 328 ! ! allocate sbccpl arrays 276 IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' )329 !IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 277 330 278 331 ! ================================ ! … … 337 390 srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point 338 391 srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point 339 srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 392 !srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 393 ! Currently needed for HadGEM3 - but shouldn't affect anyone else for the moment 394 srcv(jpr_otx1)%laction = .TRUE. 395 srcv(jpr_oty1)%laction = .TRUE. 396 ! 340 397 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only 341 398 CASE( 'T,I' ) … … 383 440 srcv(jpr_snow)%clname = 'OTotSnow' ! Snow = solid precipitation 384 441 srcv(jpr_tevp)%clname = 'OTotEvap' ! total evaporation (over oce + ice sublimation) 385 srcv(jpr_ievp)%clname = 'OIceEv ap' ! evaporation over ice = sublimation442 srcv(jpr_ievp)%clname = 'OIceEvp' ! evaporation over ice = sublimation 386 443 srcv(jpr_sbpr)%clname = 'OSubMPre' ! sublimation - liquid precipitation - solid precipitation 387 444 srcv(jpr_semp)%clname = 'OISubMSn' ! ice solid water budget = sublimation - solid precipitation … … 396 453 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) 397 454 END SELECT 398 455 !Set the number of categories for coupling of sublimation 456 IF ( TRIM( sn_rcv_emp%clcat ) == 'yes' ) srcv(jpr_ievp)%nct = jpl 457 ! 399 458 ! ! ------------------------- ! 400 459 ! ! Runoffs & Calving ! … … 410 469 ! 411 470 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 471 srcv(jpr_grnm )%clname = 'OGrnmass' ; IF( TRIM( sn_rcv_grnm%cldes ) == 'coupled' ) srcv(jpr_grnm)%laction = .TRUE. 472 srcv(jpr_antm )%clname = 'OAntmass' ; IF( TRIM( sn_rcv_antm%cldes ) == 'coupled' ) srcv(jpr_antm)%laction = .TRUE. 473 412 474 413 475 ! ! ------------------------- ! … … 470 532 ! ! ------------------------- ! 471 533 srcv(jpr_co2 )%clname = 'O_AtmCO2' ; IF( TRIM(sn_rcv_co2%cldes ) == 'coupled' ) srcv(jpr_co2 )%laction = .TRUE. 534 535 536 ! ! --------------------------------------- ! 537 ! ! Incoming CO2 and DUST fluxes for MEDUSA ! 538 ! ! --------------------------------------- ! 539 srcv(jpr_atm_pco2)%clname = 'OATMPCO2' 540 541 IF (TRIM(sn_rcv_atm_pco2%cldes) == 'medusa') THEN 542 srcv(jpr_atm_pco2)%laction = .TRUE. 543 END IF 544 545 srcv(jpr_atm_dust)%clname = 'OATMDUST' 546 IF (TRIM(sn_rcv_atm_dust%cldes) == 'medusa') THEN 547 srcv(jpr_atm_dust)%laction = .TRUE. 548 END IF 549 472 550 ! ! ------------------------- ! 473 551 ! ! topmelt and botmelt ! … … 483 561 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 484 562 ENDIF 563 564 #if defined key_cice && ! defined key_cice4 565 ! ! ----------------------------- ! 566 ! ! sea-ice skin temperature ! 567 ! ! used in meltpond scheme ! 568 ! ! May be calculated in Atm ! 569 ! ! ----------------------------- ! 570 srcv(jpr_ts_ice)%clname = 'OTsfIce' 571 IF ( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' ) srcv(jpr_ts_ice)%laction = .TRUE. 572 IF ( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' ) srcv(jpr_ts_ice)%nct = jpl 573 !TODO: Should there be a consistency check here? 574 #endif 575 485 576 ! ! ------------------------------- ! 486 577 ! ! OPA-SAS coupling - rcv by opa ! … … 600 691 ! ! ------------------------- ! 601 692 ssnd(jps_toce)%clname = 'O_SSTSST' 602 ssnd(jps_tice)%clname = 'O _TepIce'693 ssnd(jps_tice)%clname = 'OTepIce' 603 694 ssnd(jps_tmix)%clname = 'O_TepMix' 604 695 SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 605 696 CASE( 'none' ) ! nothing to do 606 697 CASE( 'oce only' ) ; ssnd( jps_toce )%laction = .TRUE. 607 CASE( 'oce and ice' , 'weighted oce and ice' )698 CASE( 'oce and ice' , 'weighted oce and ice' , 'oce and weighted ice') 608 699 ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 609 700 IF ( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = jpl … … 634 725 635 726 ! ! ------------------------- ! 636 ! ! Ice fraction & Thickness !727 ! ! Ice fraction & Thickness 637 728 ! ! ------------------------- ! 638 729 ssnd(jps_fice)%clname = 'OIceFrc' 639 730 ssnd(jps_hice)%clname = 'OIceTck' 640 731 ssnd(jps_hsnw)%clname = 'OSnwTck' 732 ssnd(jps_a_p)%clname = 'OPndFrc' 733 ssnd(jps_ht_p)%clname = 'OPndTck' 734 ssnd(jps_fice1)%clname = 'OIceFrd' 641 735 IF( k_ice /= 0 ) THEN 642 736 ssnd(jps_fice)%laction = .TRUE. ! if ice treated in the ocean (even in climato case) 737 ssnd(jps_fice1)%laction = .TRUE. ! First-order regridded ice concentration, to be used 738 ! in producing atmos-to-ice fluxes 643 739 ! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now 644 740 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 741 IF ( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = jpl 645 742 ENDIF 646 743 … … 657 754 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' ) 658 755 END SELECT 756 757 ! ! ------------------------- ! 758 ! ! Ice Meltponds ! 759 ! ! ------------------------- ! 760 #if defined key_cice && ! defined key_cice4 761 ! Meltponds only CICE5 762 ssnd(jps_a_p)%clname = 'OPndFrc' 763 ssnd(jps_ht_p)%clname = 'OPndTck' 764 SELECT CASE ( TRIM( sn_snd_mpnd%cldes ) ) 765 CASE ( 'none' ) 766 ssnd(jps_a_p)%laction = .FALSE. 767 ssnd(jps_ht_p)%laction = .FALSE. 768 CASE ( 'ice only' ) 769 ssnd(jps_a_p)%laction = .TRUE. 770 ssnd(jps_ht_p)%laction = .TRUE. 771 IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 772 ssnd(jps_a_p)%nct = jpl 773 ssnd(jps_ht_p)%nct = jpl 774 ELSE 775 IF ( jpl > 1 ) THEN 776 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' ) 777 ENDIF 778 ENDIF 779 CASE ( 'weighted ice' ) 780 ssnd(jps_a_p)%laction = .TRUE. 781 ssnd(jps_ht_p)%laction = .TRUE. 782 IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 783 ssnd(jps_a_p)%nct = jpl 784 ssnd(jps_ht_p)%nct = jpl 785 ENDIF 786 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_mpnd%cldes' ) 787 END SELECT 788 #else 789 IF( TRIM( sn_snd_mpnd%cldes ) /= 'none' ) THEN 790 CALL ctl_stop('Meltponds can only be used with CICEv5') 791 ENDIF 792 #endif 659 793 660 794 ! ! ------------------------- ! … … 689 823 ! ! ------------------------- ! 690 824 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 825 ! 826 827 ! ! ------------------------- ! 828 ! ! MEDUSA output fields ! 829 ! ! ------------------------- ! 830 ! Surface dimethyl sulphide from Medusa 831 ssnd(jps_bio_dms)%clname = 'OBioDMS' 832 IF( TRIM(sn_snd_bio_dms%cldes) == 'medusa' ) ssnd(jps_bio_dms )%laction = .TRUE. 833 834 ! Surface CO2 flux from Medusa 835 ssnd(jps_bio_co2)%clname = 'OBioCO2' 836 IF( TRIM(sn_snd_bio_co2%cldes) == 'medusa' ) ssnd(jps_bio_co2 )%laction = .TRUE. 837 838 ! Surface chlorophyll from Medusa 839 ssnd(jps_bio_chloro)%clname = 'OBioChlo' 840 IF( TRIM(sn_snd_bio_chloro%cldes) == 'medusa' ) ssnd(jps_bio_chloro )%laction = .TRUE. 841 842 ! ! ------------------------- ! 843 ! ! Sea surface freezing temp ! 844 ! ! ------------------------- ! 845 ssnd(jps_sstfrz)%clname = 'O_SSTFrz' ; IF( TRIM(sn_snd_sstfrz%cldes) == 'coupled' ) ssnd(jps_sstfrz)%laction = .TRUE. 846 ! 847 ! ! ------------------------- ! 848 ! ! Ice conductivity ! 849 ! ! ------------------------- ! 850 ! Note that ultimately we will move to passing an ocean effective conductivity as well so there 851 ! will be some changes to the parts of the code which currently relate only to ice conductivity 852 ssnd(jps_kice )%clname = 'OIceKn' 853 SELECT CASE ( TRIM( sn_snd_cond%cldes ) ) 854 CASE ( 'none' ) 855 ssnd(jps_kice)%laction = .FALSE. 856 CASE ( 'ice only' ) 857 ssnd(jps_kice)%laction = .TRUE. 858 IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN 859 ssnd(jps_kice)%nct = jpl 860 ELSE 861 IF ( jpl > 1 ) THEN 862 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' ) 863 ENDIF 864 ENDIF 865 CASE ( 'weighted ice' ) 866 ssnd(jps_kice)%laction = .TRUE. 867 IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = jpl 868 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes' ) 869 END SELECT 870 ! 871 691 872 692 873 ! ! ------------------------------- ! … … 785 966 ncpl_qsr_freq = 86400 / ncpl_qsr_freq 786 967 968 IF( nn_coupled_iceshelf_fluxes .gt. 0 ) THEN 969 ! Crude masks to separate the Antarctic and Greenland icesheets. Obviously something 970 ! more complicated could be done if required. 971 greenland_icesheet_mask = 0.0 972 WHERE( gphit >= 0.0 ) greenland_icesheet_mask = 1.0 973 antarctica_icesheet_mask = 0.0 974 WHERE( gphit < 0.0 ) antarctica_icesheet_mask = 1.0 975 976 ! initialise other variables 977 greenland_icesheet_mass_array(:,:) = 0.0 978 antarctica_icesheet_mass_array(:,:) = 0.0 979 980 IF( .not. ln_rstart ) THEN 981 greenland_icesheet_mass = 0.0 982 greenland_icesheet_mass_rate_of_change = 0.0 983 greenland_icesheet_timelapsed = 0.0 984 antarctica_icesheet_mass = 0.0 985 antarctica_icesheet_mass_rate_of_change = 0.0 986 antarctica_icesheet_timelapsed = 0.0 987 ENDIF 988 989 ENDIF 990 787 991 CALL wrk_dealloc( jpi,jpj, zacs, zaos ) 788 992 ! … … 843 1047 !! 844 1048 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 845 INTEGER :: ji, jj, j n! dummy loop indices1049 INTEGER :: ji, jj, jl, jn ! dummy loop indices 846 1050 INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000) 1051 INTEGER :: ikchoix 847 1052 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 1053 REAL(wp) :: zgreenland_icesheet_mass_in, zantarctica_icesheet_mass_in 1054 REAL(wp) :: zgreenland_icesheet_mass_b, zantarctica_icesheet_mass_b 1055 REAL(wp) :: zmask_sum, zepsilon 848 1056 REAL(wp) :: zcoef ! temporary scalar 849 1057 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 850 1058 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 851 1059 REAL(wp) :: zzx, zzy ! temporary variables 852 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr 1060 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 853 1061 !!---------------------------------------------------------------------- 1062 854 1063 ! 855 1064 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') 856 1065 ! 857 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )1066 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) 858 1067 ! 859 1068 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 893 1102 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 894 1103 ! ! (geographical to local grid -> rotate the components) 895 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 896 IF( srcv(jpr_otx2)%laction ) THEN 897 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 898 ELSE 899 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 1104 IF( srcv(jpr_otx1)%clgrid == 'U' .AND. (.NOT. srcv(jpr_otx2)%laction) ) THEN 1105 ! Temporary code for HadGEM3 - will be removed eventually. 1106 ! Only applies when we have only taux on U grid and tauy on V grid 1107 DO jj=2,jpjm1 1108 DO ji=2,jpim1 1109 ztx(ji,jj)=0.25*vmask(ji,jj,1) & 1110 *(frcv(jpr_otx1)%z3(ji,jj,1)+frcv(jpr_otx1)%z3(ji-1,jj,1) & 1111 +frcv(jpr_otx1)%z3(ji,jj+1,1)+frcv(jpr_otx1)%z3(ji-1,jj+1,1)) 1112 zty(ji,jj)=0.25*umask(ji,jj,1) & 1113 *(frcv(jpr_oty1)%z3(ji,jj,1)+frcv(jpr_oty1)%z3(ji+1,jj,1) & 1114 +frcv(jpr_oty1)%z3(ji,jj-1,1)+frcv(jpr_oty1)%z3(ji+1,jj-1,1)) 1115 ENDDO 1116 ENDDO 1117 1118 ikchoix = 1 1119 CALL repcmo (frcv(jpr_otx1)%z3(:,:,1),zty,ztx,frcv(jpr_oty1)%z3(:,:,1),ztx2,zty2,ikchoix) 1120 CALL lbc_lnk (ztx2,'U', -1. ) 1121 CALL lbc_lnk (zty2,'V', -1. ) 1122 frcv(jpr_otx1)%z3(:,:,1)=ztx2(:,:) 1123 frcv(jpr_oty1)%z3(:,:,1)=zty2(:,:) 1124 ELSE 1125 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 1126 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 1127 IF( srcv(jpr_otx2)%laction ) THEN 1128 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 1129 ELSE 1130 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 1131 ENDIF 1132 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid 900 1133 ENDIF 901 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid902 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid903 1134 ENDIF 904 1135 ! … … 990 1221 ENDIF 991 1222 1223 IF (ln_medusa) THEN 1224 IF( srcv(jpr_atm_pco2)%laction) PCO2a_in_cpl(:,:) = frcv(jpr_atm_pco2)%z3(:,:,1) 1225 IF( srcv(jpr_atm_dust)%laction) Dust_in_cpl(:,:) = frcv(jpr_atm_dust)%z3(:,:,1) 1226 ENDIF 1227 992 1228 #if defined key_cpl_carbon_cycle 993 1229 ! ! ================== ! … … 995 1231 ! ! ================== ! 996 1232 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 1233 #endif 1234 1235 #if defined key_cice && ! defined key_cice4 1236 ! ! Sea ice surface skin temp: 1237 IF( srcv(jpr_ts_ice)%laction ) THEN 1238 DO jl = 1, jpl 1239 DO jj = 1, jpj 1240 DO ji = 1, jpi 1241 IF (frcv(jpr_ts_ice)%z3(ji,jj,jl) > 0.0) THEN 1242 tsfc_ice(ji,jj,jl) = 0.0 1243 ELSE IF (frcv(jpr_ts_ice)%z3(ji,jj,jl) < -60.0) THEN 1244 tsfc_ice(ji,jj,jl) = -60.0 1245 ELSE 1246 tsfc_ice(ji,jj,jl) = frcv(jpr_ts_ice)%z3(ji,jj,jl) 1247 ENDIF 1248 END DO 1249 END DO 1250 END DO 1251 ENDIF 997 1252 #endif 998 1253 … … 1029 1284 ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 1030 1285 ub (:,:,1) = ssu_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau 1286 un (:,:,1) = ssu_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1031 1287 CALL iom_put( 'ssu_m', ssu_m ) 1032 1288 ENDIF … … 1034 1290 ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 1035 1291 vb (:,:,1) = ssv_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau 1292 vn (:,:,1) = ssv_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1036 1293 CALL iom_put( 'ssv_m', ssv_m ) 1037 1294 ENDIF … … 1110 1367 1111 1368 ENDIF 1112 ! 1113 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 1369 1370 ! ! land ice masses : Greenland 1371 zepsilon = rn_iceshelf_fluxes_tolerance 1372 1373 1374 ! See if we need zmask_sum... 1375 IF ( srcv(jpr_grnm)%laction .OR. srcv(jpr_antm)%laction ) THEN 1376 zmask_sum = glob_sum( tmask(:,:,1) ) 1377 ENDIF 1378 1379 IF( srcv(jpr_grnm)%laction .AND. nn_coupled_iceshelf_fluxes == 1 ) THEN 1380 greenland_icesheet_mass_array(:,:) = frcv(jpr_grnm)%z3(:,:,1) 1381 ! take average over ocean points of input array to avoid cumulative error over time 1382 ! The following must be bit reproducible over different PE decompositions 1383 zgreenland_icesheet_mass_in = glob_sum( greenland_icesheet_mass_array(:,:) * tmask(:,:,1) ) 1384 1385 zgreenland_icesheet_mass_in = zgreenland_icesheet_mass_in / zmask_sum 1386 greenland_icesheet_timelapsed = greenland_icesheet_timelapsed + rdt 1387 1388 IF( ln_iceshelf_init_atmos .AND. kt == 1 ) THEN 1389 ! On the first timestep (of an NRUN) force the ocean to ignore the icesheet masses in the ocean restart 1390 ! and take them from the atmosphere to avoid problems with using inconsistent ocean and atmosphere restarts. 1391 zgreenland_icesheet_mass_b = zgreenland_icesheet_mass_in 1392 greenland_icesheet_mass = zgreenland_icesheet_mass_in 1393 ENDIF 1394 1395 IF( ABS( zgreenland_icesheet_mass_in - greenland_icesheet_mass ) > zepsilon ) THEN 1396 zgreenland_icesheet_mass_b = greenland_icesheet_mass 1397 1398 ! Only update the mass if it has increased. 1399 IF ( (zgreenland_icesheet_mass_in - greenland_icesheet_mass) > 0.0 ) THEN 1400 greenland_icesheet_mass = zgreenland_icesheet_mass_in 1401 ENDIF 1402 1403 IF( zgreenland_icesheet_mass_b /= 0.0 ) & 1404 & greenland_icesheet_mass_rate_of_change = ( greenland_icesheet_mass - zgreenland_icesheet_mass_b ) / greenland_icesheet_timelapsed 1405 greenland_icesheet_timelapsed = 0.0_wp 1406 ENDIF 1407 IF(lwp) WRITE(numout,*) 'Greenland icesheet mass (kg) read in is ', zgreenland_icesheet_mass_in 1408 IF(lwp) WRITE(numout,*) 'Greenland icesheet mass (kg) used is ', greenland_icesheet_mass 1409 IF(lwp) WRITE(numout,*) 'Greenland icesheet mass rate of change (kg/s) is ', greenland_icesheet_mass_rate_of_change 1410 IF(lwp) WRITE(numout,*) 'Greenland icesheet seconds lapsed since last change is ', greenland_icesheet_timelapsed 1411 ELSE IF ( nn_coupled_iceshelf_fluxes == 2 ) THEN 1412 greenland_icesheet_mass_rate_of_change = rn_greenland_total_fw_flux 1413 ENDIF 1414 1415 ! ! land ice masses : Antarctica 1416 IF( srcv(jpr_antm)%laction .AND. nn_coupled_iceshelf_fluxes == 1 ) THEN 1417 antarctica_icesheet_mass_array(:,:) = frcv(jpr_antm)%z3(:,:,1) 1418 ! take average over ocean points of input array to avoid cumulative error from rounding errors over time 1419 ! The following must be bit reproducible over different PE decompositions 1420 zantarctica_icesheet_mass_in = glob_sum( antarctica_icesheet_mass_array(:,:) * tmask(:,:,1) ) 1421 1422 zantarctica_icesheet_mass_in = zantarctica_icesheet_mass_in / zmask_sum 1423 antarctica_icesheet_timelapsed = antarctica_icesheet_timelapsed + rdt 1424 1425 IF( ln_iceshelf_init_atmos .AND. kt == 1 ) THEN 1426 ! On the first timestep (of an NRUN) force the ocean to ignore the icesheet masses in the ocean restart 1427 ! and take them from the atmosphere to avoid problems with using inconsistent ocean and atmosphere restarts. 1428 zantarctica_icesheet_mass_b = zantarctica_icesheet_mass_in 1429 antarctica_icesheet_mass = zantarctica_icesheet_mass_in 1430 ENDIF 1431 1432 IF( ABS( zantarctica_icesheet_mass_in - antarctica_icesheet_mass ) > zepsilon ) THEN 1433 zantarctica_icesheet_mass_b = antarctica_icesheet_mass 1434 1435 ! Only update the mass if it has increased. 1436 IF ( (zantarctica_icesheet_mass_in - antarctica_icesheet_mass) > 0.0 ) THEN 1437 antarctica_icesheet_mass = zantarctica_icesheet_mass_in 1438 END IF 1439 1440 IF( zantarctica_icesheet_mass_b /= 0.0 ) & 1441 & antarctica_icesheet_mass_rate_of_change = ( antarctica_icesheet_mass - zantarctica_icesheet_mass_b ) / antarctica_icesheet_timelapsed 1442 antarctica_icesheet_timelapsed = 0.0_wp 1443 ENDIF 1444 IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass (kg) read in is ', zantarctica_icesheet_mass_in 1445 IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass (kg) used is ', antarctica_icesheet_mass 1446 IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass rate of change (kg/s) is ', antarctica_icesheet_mass_rate_of_change 1447 IF(lwp) WRITE(numout,*) 'Antarctica icesheet seconds lapsed since last change is ', antarctica_icesheet_timelapsed 1448 ELSE IF ( nn_coupled_iceshelf_fluxes == 2 ) THEN 1449 antarctica_icesheet_mass_rate_of_change = rn_antarctica_total_fw_flux 1450 ENDIF 1451 1452 ! 1453 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) 1114 1454 ! 1115 1455 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv') … … 1333 1673 !! *** ROUTINE sbc_cpl_ice_flx *** 1334 1674 !! 1335 !! ** Purpose : provide the heat and freshwater fluxes of the 1336 !! ocean-ice system. 1675 !! ** Purpose : provide the heat and freshwater fluxes of the ocean-ice system 1337 1676 !! 1338 1677 !! ** Method : transform the fields received from the atmosphere into 1339 1678 !! surface heat and fresh water boundary condition for the 1340 1679 !! ice-ocean system. The following fields are provided: 1341 !! * total non solar, solar and freshwater fluxes (qns_tot,1680 !! * total non solar, solar and freshwater fluxes (qns_tot, 1342 1681 !! qsr_tot and emp_tot) (total means weighted ice-ocean flux) 1343 1682 !! NB: emp_tot include runoffs and calving. 1344 !! * fluxes over ice (qns_ice, qsr_ice, emp_ice) where1683 !! * fluxes over ice (qns_ice, qsr_ice, emp_ice) where 1345 1684 !! emp_ice = sublimation - solid precipitation as liquid 1346 1685 !! precipitation are re-routed directly to the ocean and 1347 !! runoffs and calving directly enter the ocean.1348 !! * solid precipitation (sprecip), used to add to qns_tot1686 !! calving directly enter the ocean (runoffs are read but included in trasbc.F90) 1687 !! * solid precipitation (sprecip), used to add to qns_tot 1349 1688 !! the heat lost associated to melting solid precipitation 1350 1689 !! over the ocean fraction. 1351 !! ===>> CAUTION here this changes the net heat flux received from 1352 !! the atmosphere 1353 !! 1354 !! - the fluxes have been separated from the stress as 1355 !! (a) they are updated at each ice time step compare to 1356 !! an update at each coupled time step for the stress, and 1357 !! (b) the conservative computation of the fluxes over the 1358 !! sea-ice area requires the knowledge of the ice fraction 1359 !! after the ice advection and before the ice thermodynamics, 1360 !! so that the stress is updated before the ice dynamics 1361 !! while the fluxes are updated after it. 1690 !! * heat content of rain, snow and evap can also be provided, 1691 !! otherwise heat flux associated with these mass flux are 1692 !! guessed (qemp_oce, qemp_ice) 1693 !! 1694 !! - the fluxes have been separated from the stress as 1695 !! (a) they are updated at each ice time step compare to 1696 !! an update at each coupled time step for the stress, and 1697 !! (b) the conservative computation of the fluxes over the 1698 !! sea-ice area requires the knowledge of the ice fraction 1699 !! after the ice advection and before the ice thermodynamics, 1700 !! so that the stress is updated before the ice dynamics 1701 !! while the fluxes are updated after it. 1702 !! 1703 !! ** Details 1704 !! qns_tot = pfrld * qns_oce + ( 1 - pfrld ) * qns_ice => provided 1705 !! + qemp_oce + qemp_ice => recalculated and added up to qns 1706 !! 1707 !! qsr_tot = pfrld * qsr_oce + ( 1 - pfrld ) * qsr_ice => provided 1708 !! 1709 !! emp_tot = emp_oce + emp_ice => calving is provided and added to emp_tot (and emp_oce) 1710 !! river runoff (rnf) is provided but not included here 1362 1711 !! 1363 1712 !! ** Action : update at each nf_ice time step: 1364 1713 !! qns_tot, qsr_tot non-solar and solar total heat fluxes 1365 1714 !! qns_ice, qsr_ice non-solar and solar heat fluxes over the ice 1366 !! emp_tot total evaporation - precipitation(liquid and solid) (-runoff)(-calving)1367 !! emp_ice 1368 !! dqns_ice 1369 !! sprecip 1715 !! emp_tot total evaporation - precipitation(liquid and solid) (-calving) 1716 !! emp_ice ice sublimation - solid precipitation over the ice 1717 !! dqns_ice d(non-solar heat flux)/d(Temperature) over the ice 1718 !! sprecip solid precipitation over the ocean 1370 1719 !!---------------------------------------------------------------------- 1371 1720 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] … … 1376 1725 ! 1377 1726 INTEGER :: jl ! dummy loop index 1378 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk 1379 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, z sprecip, ztprecip, zqns_tot, zqsr_tot1380 REAL(wp), POINTER, DIMENSION(:,: ,:) :: zqns_ice, zqsr_ice, zdqns_ice1381 REAL(wp), POINTER, DIMENSION(:,: ) :: zevap, zsnw, zqns_oce, zqsr_oce, zqprec_ice, zqemp_oce ! for LIM31727 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk, zsnw 1728 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice 1729 REAL(wp), POINTER, DIMENSION(:,: ) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1730 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice 1382 1731 !!---------------------------------------------------------------------- 1383 1732 ! 1384 1733 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx') 1385 1734 ! 1386 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1387 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1735 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zsnw ) 1736 CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 1737 CALL wrk_alloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1738 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) 1388 1739 1389 1740 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1392 1743 ! 1393 1744 ! ! ========================= ! 1394 ! ! freshwater budget ! (emp )1745 ! ! freshwater budget ! (emp_tot) 1395 1746 ! ! ========================= ! 1396 1747 ! 1397 ! ! total Precipitation - total Evaporation (emp_tot)1398 ! ! solid precipitation - sublimation (emp_ice)1399 ! ! solid Precipitation (sprecip)1400 ! ! liquid + solid Precipitation (tprecip)1748 ! ! solid Precipitation (sprecip) 1749 ! ! liquid + solid Precipitation (tprecip) 1750 ! ! total Evaporation - total Precipitation (emp_tot) 1751 ! ! sublimation - solid precipitation (cell average) (emp_ice) 1401 1752 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 1402 1753 CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 1403 1754 zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here 1404 1755 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1405 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1406 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1407 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1756 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1757 #if defined key_cice 1758 IF ( TRIM(sn_rcv_emp%clcat) == 'yes' ) THEN 1759 ! zemp_ice is the sum of frcv(jpr_ievp)%z3(:,:,1) over all layers - snow 1760 zemp_ice(:,:) = - frcv(jpr_snow)%z3(:,:,1) 1761 DO jl=1,jpl 1762 zemp_ice(:,: ) = zemp_ice(:,:) + frcv(jpr_ievp)%z3(:,:,jl) 1763 ENDDO 1764 ! latent heat coupled for each category in CICE 1765 qla_ice(:,:,1:jpl) = - frcv(jpr_ievp)%z3(:,:,1:jpl) * lsub 1766 ELSE 1767 ! If CICE has multicategories it still expects coupling fields for 1768 ! each even if we treat as a single field 1769 ! The latent heat flux is split between the ice categories according 1770 ! to the fraction of the ice in each category 1771 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1772 WHERE ( zicefr(:,:) /= 0._wp ) 1773 ztmp(:,:) = 1./zicefr(:,:) 1774 ELSEWHERE 1775 ztmp(:,:) = 0.e0 1776 END WHERE 1777 DO jl=1,jpl 1778 qla_ice(:,:,jl) = - a_i(:,:,jl) * ztmp(:,:) * frcv(jpr_ievp)%z3(:,:,1) * lsub 1779 END DO 1780 WHERE ( zicefr(:,:) == 0._wp ) qla_ice(:,:,1) = -frcv(jpr_ievp)%z3(:,:,1) * lsub 1781 ENDIF 1782 #else 1783 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * zicefr(:,:) 1784 #endif 1785 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) * tmask(:,:,1) ) ! liquid precipitation 1786 CALL iom_put( 'rain_ao_cea' , frcv(jpr_rain)%z3(:,:,1)* p_frld(:,:) * tmask(:,:,1) ) ! liquid precipitation 1408 1787 IF( iom_use('hflx_rain_cea') ) & 1409 CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1788 & CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) * tmask(:,:,1)) ! heat flux from liq. precip. 1789 IF( iom_use('hflx_prec_cea') ) & 1790 & CALL iom_put( 'hflx_prec_cea', ztprecip * zcptn(:,:) * tmask(:,:,1) * p_frld(:,:) ) ! heat content flux from all precip (cell avg) 1410 1791 IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) & 1411 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:)1792 & ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1412 1793 IF( iom_use('evap_ao_cea' ) ) & 1413 CALL iom_put( 'evap_ao_cea' , ztmp) ! ice-free oce evap (cell average)1794 & CALL iom_put( 'evap_ao_cea' , ztmp * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1414 1795 IF( iom_use('hflx_evap_cea') ) & 1415 CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) ) ! heat flux from from evap (cell average)1416 CASE( 'oce and ice' 1796 & CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) * tmask(:,:,1) ) ! heat flux from from evap (cell average) 1797 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1417 1798 zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1418 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1799 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * zicefr(:,:) 1419 1800 zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 1420 1801 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 1421 1802 END SELECT 1422 1803 1423 IF( iom_use('subl_ai_cea') ) & 1424 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1425 ! 1426 ! ! runoffs and calving (put in emp_tot) 1804 #if defined key_lim3 1805 ! zsnw = snow fraction over ice after wind blowing 1806 zsnw(:,:) = 0._wp ; CALL lim_thd_snwblow( p_frld, zsnw ) 1807 1808 ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- ! 1809 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( zicefr(:,:) - zsnw(:,:) ) ! emp_ice = A * sublimation - zsnw * sprecip 1810 zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) ! emp_oce = emp_tot - emp_ice 1811 1812 ! --- evaporation over ocean (used later for qemp) --- ! 1813 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1814 1815 ! --- evaporation over ice (kg/m2/s) --- ! 1816 zevap_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) 1817 ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 1818 ! therefore, sublimation is not redistributed over the ice categories in case no subgrid scale fluxes are provided by atm. 1819 zdevap_ice(:,:) = 0._wp 1820 1821 ! --- runoffs (included in emp later on) --- ! 1427 1822 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1823 1824 ! --- calving (put in emp_tot and emp_oce) --- ! 1825 IF( srcv(jpr_cal)%laction ) THEN 1826 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1827 zemp_oce(:,:) = zemp_oce(:,:) - frcv(jpr_cal)%z3(:,:,1) 1828 CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 1829 ENDIF 1830 1831 IF( ln_mixcpl ) THEN 1832 emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 1833 emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 1834 emp_oce(:,:) = emp_oce(:,:) * xcplmask(:,:,0) + zemp_oce(:,:) * zmsk(:,:) 1835 sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1836 tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1837 DO jl=1,jpl 1838 evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:) * zmsk(:,:) 1839 devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:) * zmsk(:,:) 1840 ENDDO 1841 ELSE 1842 emp_tot(:,:) = zemp_tot(:,:) 1843 emp_ice(:,:) = zemp_ice(:,:) 1844 emp_oce(:,:) = zemp_oce(:,:) 1845 sprecip(:,:) = zsprecip(:,:) 1846 tprecip(:,:) = ztprecip(:,:) 1847 DO jl=1,jpl 1848 evap_ice (:,:,jl) = zevap_ice (:,:) 1849 devap_ice(:,:,jl) = zdevap_ice(:,:) 1850 ENDDO 1851 ENDIF 1852 1853 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', zevap_ice(:,:) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1854 CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow 1855 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea', sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1856 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1857 #else 1858 ! runoffs and calving (put in emp_tot) 1859 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1860 IF( iom_use('hflx_rnf_cea') ) & 1861 CALL iom_put( 'hflx_rnf_cea' , rnf(:,:) * zcptn(:,:) ) 1428 1862 IF( srcv(jpr_cal)%laction ) THEN 1429 1863 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) … … 1443 1877 ENDIF 1444 1878 1445 CALL iom_put( 'snowpre' , sprecip ) ! Snow1446 IF( iom_use('snow_ao_cea') ) &1447 CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:) ) ! Snowover ice-free ocean (cell average)1448 IF( iom_use('snow_ai_cea') ) &1449 CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1879 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1880 CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow 1881 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average) 1882 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1883 #endif 1450 1884 1451 1885 ! ! ========================= ! 1452 1886 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) ! non solar heat fluxes ! (qns) 1453 1887 ! ! ========================= ! 1454 CASE( 'oce only' ) 1455 zqns_tot(:,: 1456 CASE( 'conservative' ) 1457 zqns_tot(:,: 1888 CASE( 'oce only' ) ! the required field is directly provided 1889 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 1890 CASE( 'conservative' ) ! the required fields are directly provided 1891 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1458 1892 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1459 1893 zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1460 1894 ELSE 1461 ! Set all category values equal for the moment1462 1895 DO jl=1,jpl 1463 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1896 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) ! Set all category values equal 1464 1897 ENDDO 1465 1898 ENDIF 1466 CASE( 'oce and ice' ) 1467 zqns_tot(:,: 1899 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1900 zqns_tot(:,:) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1468 1901 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1469 1902 DO jl=1,jpl … … 1472 1905 ENDDO 1473 1906 ELSE 1474 qns_tot(:,: 1907 qns_tot(:,:) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1475 1908 DO jl=1,jpl 1476 1909 zqns_tot(:,: ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) … … 1478 1911 ENDDO 1479 1912 ENDIF 1480 CASE( 'mixed oce-ice' ) 1913 CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations 1481 1914 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1482 1915 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1483 1916 zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1484 1917 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) & 1485 & + pist(:,:,1)* zicefr(:,:) ) )1918 & + pist(:,:,1) * zicefr(:,:) ) ) 1486 1919 END SELECT 1487 1920 !!gm … … 1493 1926 !! similar job should be done for snow and precipitation temperature 1494 1927 ! 1495 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1496 ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1497 zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:) 1498 IF( iom_use('hflx_cal_cea') ) & 1499 CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1500 ENDIF 1501 1502 ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus 1503 IF( iom_use('hflx_snow_cea') ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1504 1505 #if defined key_lim3 1506 CALL wrk_alloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 1507 1508 ! --- evaporation --- ! 1509 ! clem: evap_ice is set to 0 for LIM3 since we still do not know what to do with sublimation 1510 ! the problem is: the atm. imposes both mass evaporation and heat removed from the snow/ice 1511 ! but it is incoherent WITH the ice model 1512 DO jl=1,jpl 1513 evap_ice(:,:,jl) = 0._wp ! should be: frcv(jpr_ievp)%z3(:,:,1) 1514 ENDDO 1515 zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean 1516 1517 ! --- evaporation minus precipitation --- ! 1518 emp_oce(:,:) = emp_tot(:,:) - emp_ice(:,:) 1519 1928 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1929 zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1930 ! we suppose it melts at 0deg, though it should be temp. of surrounding ocean 1931 IF( iom_use('hflx_cal_cea') ) CALL iom_put( 'hflx_cal_cea', - frcv(jpr_cal)%z3(:,:,1) * lfus ) ! heat flux from calving 1932 ENDIF 1933 1934 #if defined key_lim3 1520 1935 ! --- non solar flux over ocean --- ! 1521 1936 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax … … 1523 1938 WHERE( p_frld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:) 1524 1939 1525 ! --- heat flux associated with emp --- !1526 z snw(:,:) = 0._wp1527 CALL lim_thd_snwblow( p_frld, zsnw ) ! snow distribution over ice after wind blowing1528 zqemp_oce(:,:) = - zevap(:,:) * p_frld(:,:) * zcptn(:,:) & ! evap1529 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip1530 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean 1531 qemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap1532 & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice1533 1534 ! --- heat content ofprecip over ice in J/m3 (to be used in 1D-thermo) --- !1940 ! --- heat flux associated with emp (W/m2) --- ! 1941 zqemp_oce(:,:) = - zevap_oce(:,:) * zcptn(:,:) & ! evap 1942 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip 1943 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean + snow melting 1944 ! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap 1945 ! & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice 1946 zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice (only) 1947 ! qevap_ice=0 since we consider Tice=0degC 1948 1949 ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! 1535 1950 zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 1536 1951 1537 ! --- total non solar flux --- ! 1538 zqns_tot(:,:) = zqns_tot(:,:) + qemp_ice(:,:) + zqemp_oce(:,:) 1952 ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 1953 DO jl = 1, jpl 1954 zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but we do not have Tice, so we consider Tice=0degC 1955 END DO 1956 1957 ! --- total non solar flux (including evap/precip) --- ! 1958 zqns_tot(:,:) = zqns_tot(:,:) + zqemp_ice(:,:) + zqemp_oce(:,:) 1539 1959 1540 1960 ! --- in case both coupled/forced are active, we must mix values --- ! … … 1543 1963 qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:) 1544 1964 DO jl=1,jpl 1545 qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 1965 qns_ice (:,:,jl) = qns_ice (:,:,jl) * xcplmask(:,:,0) + zqns_ice (:,:,jl)* zmsk(:,:) 1966 qevap_ice(:,:,jl) = qevap_ice(:,:,jl) * xcplmask(:,:,0) + zqevap_ice(:,:,jl)* zmsk(:,:) 1546 1967 ENDDO 1547 1968 qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:) 1548 1969 qemp_oce (:,:) = qemp_oce(:,:) * xcplmask(:,:,0) + zqemp_oce(:,:)* zmsk(:,:) 1549 !!clem evap_ice(:,:) = evap_ice(:,:) * xcplmask(:,:,0)1970 qemp_ice (:,:) = qemp_ice(:,:) * xcplmask(:,:,0) + zqemp_ice(:,:)* zmsk(:,:) 1550 1971 ELSE 1551 1972 qns_tot (:,: ) = zqns_tot (:,: ) 1552 1973 qns_oce (:,: ) = zqns_oce (:,: ) 1553 1974 qns_ice (:,:,:) = zqns_ice (:,:,:) 1554 qprec_ice(:,:) = zqprec_ice(:,:) 1555 qemp_oce (:,:) = zqemp_oce (:,:) 1556 ENDIF 1557 1558 CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 1975 qevap_ice(:,:,:) = zqevap_ice(:,:,:) 1976 qprec_ice(:,: ) = zqprec_ice(:,: ) 1977 qemp_oce (:,: ) = zqemp_oce (:,: ) 1978 qemp_ice (:,: ) = zqemp_ice (:,: ) 1979 ENDIF 1980 1981 !! clem: we should output qemp_oce and qemp_ice (at least) 1982 IF( iom_use('hflx_snow_cea') ) CALL iom_put( 'hflx_snow_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) ) ! heat flux from snow (cell average) 1983 !! these diags are not outputed yet 1984 !! IF( iom_use('hflx_rain_cea') ) CALL iom_put( 'hflx_rain_cea', ( tprecip(:,:) - sprecip(:,:) ) * zcptn(:,:) ) ! heat flux from rain (cell average) 1985 !! IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put( 'hflx_snow_ao_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) * (1._wp - zsnw(:,:)) ) ! heat flux from snow (cell average) 1986 !! IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put( 'hflx_snow_ai_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) * zsnw(:,:) ) ! heat flux from snow (cell average) 1987 1559 1988 #else 1560 1561 1989 ! clem: this formulation is certainly wrong... but better than it was... 1990 1562 1991 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 1563 & - ztmp(:,:) &! remove the latent heat flux of solid precip. melting1992 & - (p_frld(:,:) * zsprecip(:,:) * lfus) & ! remove the latent heat flux of solid precip. melting 1564 1993 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1565 & - zemp_ice(:,:) * zicefr(:,:)) * zcptn(:,:)1994 & - zemp_ice(:,:) ) * zcptn(:,:) 1566 1995 1567 1996 IF( ln_mixcpl ) THEN … … 1575 2004 qns_ice(:,:,:) = zqns_ice(:,:,:) 1576 2005 ENDIF 1577 1578 2006 #endif 1579 2007 … … 1626 2054 1627 2055 #if defined key_lim3 1628 CALL wrk_alloc( jpi,jpj, zqsr_oce )1629 2056 ! --- solar flux over ocean --- ! 1630 2057 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax … … 1634 2061 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:) 1635 2062 ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF 1636 1637 CALL wrk_dealloc( jpi,jpj, zqsr_oce )1638 2063 #endif 1639 2064 … … 1686 2111 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1687 2112 1688 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1689 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 2113 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zsnw ) 2114 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 2115 CALL wrk_dealloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 2116 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) 1690 2117 ! 1691 2118 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx') … … 1706 2133 ! 1707 2134 INTEGER :: ji, jj, jl ! dummy loop indices 2135 INTEGER :: ikchoix 1708 2136 INTEGER :: isec, info ! local integer 1709 2137 REAL(wp) :: zumax, zvmax … … 1743 2171 ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 ) 1744 2172 ELSEWHERE 1745 ztmp3(:,:,1) = rt0 ! TODO: Is freezing point a good default? (Maybe SST is better?)2173 ztmp3(:,:,1) = rt0 1746 2174 END WHERE 1747 2175 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) … … 1758 2186 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 1759 2187 END SELECT 2188 CASE( 'oce and weighted ice' ) ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0 2189 SELECT CASE( sn_snd_temp%clcat ) 2190 CASE( 'yes' ) 2191 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2192 CASE( 'no' ) 2193 ztmp3(:,:,:) = 0.0 2194 DO jl=1,jpl 2195 ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 2196 ENDDO 2197 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 2198 END SELECT 1760 2199 CASE( 'mixed oce-ice' ) 1761 2200 ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) … … 1774 2213 ! ! ------------------------- ! 1775 2214 IF( ssnd(jps_albice)%laction ) THEN ! ice 1776 SELECT CASE( sn_snd_alb%cldes ) 1777 CASE( 'ice' ) ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 1778 CASE( 'weighted ice' ) ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1779 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' ) 2215 SELECT CASE( sn_snd_alb%cldes ) 2216 CASE( 'ice' ) 2217 SELECT CASE( sn_snd_alb%clcat ) 2218 CASE( 'yes' ) 2219 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 2220 CASE( 'no' ) 2221 WHERE( SUM( a_i, dim=3 ) /= 0. ) 2222 ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 ) 2223 ELSEWHERE 2224 ztmp1(:,:) = albedo_oce_mix(:,:) 2225 END WHERE 2226 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%clcat' ) 2227 END SELECT 2228 CASE( 'weighted ice' ) ; 2229 SELECT CASE( sn_snd_alb%clcat ) 2230 CASE( 'yes' ) 2231 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2232 CASE( 'no' ) 2233 WHERE( fr_i (:,:) > 0. ) 2234 ztmp1(:,:) = SUM ( alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) 2235 ELSEWHERE 2236 ztmp1(:,:) = 0. 2237 END WHERE 2238 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ice%clcat' ) 2239 END SELECT 2240 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' ) 1780 2241 END SELECT 1781 CALL cpl_snd( jps_albice, isec, ztmp3, info ) 1782 ENDIF 2242 2243 SELECT CASE( sn_snd_alb%clcat ) 2244 CASE( 'yes' ) 2245 CALL cpl_snd( jps_albice, isec, ztmp3, info ) !-> MV this has never been checked in coupled mode 2246 CASE( 'no' ) 2247 CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2248 END SELECT 2249 ENDIF 2250 1783 2251 IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean 1784 2252 ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) … … 1799 2267 END SELECT 1800 2268 IF( ssnd(jps_fice)%laction ) CALL cpl_snd( jps_fice, isec, ztmp3, info ) 2269 ENDIF 2270 2271 ! Send ice fraction field (first order interpolation), for weighting UM fluxes to be passed to NEMO 2272 IF (ssnd(jps_fice1)%laction) THEN 2273 SELECT CASE (sn_snd_thick1%clcat) 2274 CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl) 2275 CASE( 'no' ) ; ztmp3(:,:,1) = fr_i(:,:) 2276 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick1%clcat' ) 2277 END SELECT 2278 CALL cpl_snd (jps_fice1, isec, ztmp3, info) 1801 2279 ENDIF 1802 2280 … … 1845 2323 ENDIF 1846 2324 ! 2325 #if defined key_cice && ! defined key_cice4 2326 ! Send meltpond fields 2327 IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN 2328 SELECT CASE( sn_snd_mpnd%cldes) 2329 CASE( 'weighted ice' ) 2330 SELECT CASE( sn_snd_mpnd%clcat ) 2331 CASE( 'yes' ) 2332 ztmp3(:,:,1:jpl) = a_p(:,:,1:jpl) * a_i(:,:,1:jpl) 2333 ztmp4(:,:,1:jpl) = ht_p(:,:,1:jpl) * a_i(:,:,1:jpl) 2334 CASE( 'no' ) 2335 ztmp3(:,:,:) = 0.0 2336 ztmp4(:,:,:) = 0.0 2337 DO jl=1,jpl 2338 ztmp3(:,:,1) = ztmp3(:,:,1) + a_p(:,:,jpl) * a_i(:,:,jpl) 2339 ztmp4(:,:,1) = ztmp4(:,:,1) + ht_p(:,:,jpl) * a_i(:,:,jpl) 2340 ENDDO 2341 CASE default ; CALL ctl_stop( 'sbc_cpl_mpd: wrong definition of sn_snd_mpnd%clcat' ) 2342 END SELECT 2343 CASE( 'ice only' ) 2344 ztmp3(:,:,1:jpl) = a_p(:,:,1:jpl) 2345 ztmp4(:,:,1:jpl) = ht_p(:,:,1:jpl) 2346 END SELECT 2347 IF( ssnd(jps_a_p)%laction ) CALL cpl_snd( jps_a_p, isec, ztmp3, info ) 2348 IF( ssnd(jps_ht_p)%laction ) CALL cpl_snd( jps_ht_p, isec, ztmp4, info ) 2349 ! 2350 ! Send ice effective conductivity 2351 SELECT CASE( sn_snd_cond%cldes) 2352 CASE( 'weighted ice' ) 2353 SELECT CASE( sn_snd_cond%clcat ) 2354 CASE( 'yes' ) 2355 ztmp3(:,:,1:jpl) = kn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2356 CASE( 'no' ) 2357 ztmp3(:,:,:) = 0.0 2358 DO jl=1,jpl 2359 ztmp3(:,:,1) = ztmp3(:,:,1) + kn_ice(:,:,jl) * a_i(:,:,jl) 2360 ENDDO 2361 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' ) 2362 END SELECT 2363 CASE( 'ice only' ) 2364 ztmp3(:,:,1:jpl) = kn_ice(:,:,1:jpl) 2365 END SELECT 2366 IF( ssnd(jps_kice)%laction ) CALL cpl_snd( jps_kice, isec, ztmp3, info ) 2367 ENDIF 2368 #endif 2369 ! 2370 ! 1847 2371 #if defined key_cpl_carbon_cycle 1848 2372 ! ! ------------------------- ! … … 1852 2376 ! 1853 2377 #endif 2378 2379 2380 2381 IF (ln_medusa) THEN 2382 ! ! ---------------------------------------------- ! 2383 ! ! CO2 flux, DMS and chlorophyll from MEDUSA ! 2384 ! ! ---------------------------------------------- ! 2385 IF ( ssnd(jps_bio_co2)%laction ) THEN 2386 CALL cpl_snd( jps_bio_co2, isec, RESHAPE( CO2Flux_out_cpl, (/jpi,jpj,1/) ), info ) 2387 ENDIF 2388 2389 IF ( ssnd(jps_bio_dms)%laction ) THEN 2390 CALL cpl_snd( jps_bio_dms, isec, RESHAPE( DMS_out_cpl, (/jpi,jpj,1/) ), info ) 2391 ENDIF 2392 2393 IF ( ssnd(jps_bio_chloro)%laction ) THEN 2394 CALL cpl_snd( jps_bio_chloro, isec, RESHAPE( chloro_out_cpl, (/jpi,jpj,1/) ), info ) 2395 ENDIF 2396 ENDIF 2397 1854 2398 ! ! ------------------------- ! 1855 2399 IF( ssnd(jps_ocx1)%laction ) THEN ! Surface current ! … … 1858 2402 ! j+1 j -----V---F 1859 2403 ! surface velocity always sent from T point ! | 1860 ! 2404 ! [except for HadGEM3] j | T U 1861 2405 ! | | 1862 2406 ! j j-1 -I-------| … … 1870 2414 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 1871 2415 CASE( 'oce only' ) ! C-grid ==> T 1872 DO jj = 2, jpjm1 1873 DO ji = fs_2, fs_jpim1 ! vector opt. 1874 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 1875 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 2416 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 2417 DO jj = 2, jpjm1 2418 DO ji = fs_2, fs_jpim1 ! vector opt. 2419 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 2420 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 2421 END DO 1876 2422 END DO 1877 END DO 2423 ELSE 2424 ! Temporarily Changed for UKV 2425 DO jj = 2, jpjm1 2426 DO ji = 2, jpim1 2427 zotx1(ji,jj) = un(ji,jj,1) 2428 zoty1(ji,jj) = vn(ji,jj,1) 2429 END DO 2430 END DO 2431 ENDIF 1878 2432 CASE( 'weighted oce and ice' ) 1879 2433 SELECT CASE ( cp_ice_msh ) … … 1934 2488 END DO 1935 2489 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 1936 DO jj = 2, jpjm1 1937 DO ji = 2, jpim1 ! NO vector opt. 1938 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 1939 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1940 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1941 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 1942 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1943 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 2490 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 2491 DO jj = 2, jpjm1 2492 DO ji = 2, jpim1 ! NO vector opt. 2493 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj,1) ) * zfr_l(ji,jj) & 2494 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 2495 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 2496 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji,jj-1,1) ) * zfr_l(ji,jj) & 2497 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 2498 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 2499 END DO 1944 2500 END DO 1945 END DO 2501 #if defined key_cice 2502 ELSE 2503 ! Temporarily Changed for HadGEM3 2504 DO jj = 2, jpjm1 2505 DO ji = 2, jpim1 ! NO vector opt. 2506 zotx1(ji,jj) = (1.0-fr_iu(ji,jj)) * un(ji,jj,1) & 2507 & + fr_iu(ji,jj) * 0.5 * ( u_ice(ji,jj-1) + u_ice(ji,jj) ) 2508 zoty1(ji,jj) = (1.0-fr_iv(ji,jj)) * vn(ji,jj,1) & 2509 & + fr_iv(ji,jj) * 0.5 * ( v_ice(ji-1,jj) + v_ice(ji,jj) ) 2510 END DO 2511 END DO 2512 #endif 2513 ENDIF 1946 2514 END SELECT 1947 2515 END SELECT … … 1953 2521 IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components 1954 2522 ! ! Ocean component 1955 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 1956 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 1957 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 1958 zoty1(:,:) = ztmp2(:,:) 1959 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 1960 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 1961 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 1962 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 1963 zity1(:,:) = ztmp2(:,:) 1964 ENDIF 2523 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 2524 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2525 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2526 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 2527 zoty1(:,:) = ztmp2(:,:) 2528 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 2529 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2530 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2531 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 2532 zity1(:,:) = ztmp2(:,:) 2533 ENDIF 2534 ELSE 2535 ! Temporary code for HadGEM3 - will be removed eventually. 2536 ! Only applies when we want uvel on U grid and vvel on V grid 2537 ! Rotate U and V onto geographic grid before sending. 2538 2539 DO jj=2,jpjm1 2540 DO ji=2,jpim1 2541 ztmp1(ji,jj)=0.25*vmask(ji,jj,1) & 2542 *(zotx1(ji,jj)+zotx1(ji-1,jj) & 2543 +zotx1(ji,jj+1)+zotx1(ji-1,jj+1)) 2544 ztmp2(ji,jj)=0.25*umask(ji,jj,1) & 2545 *(zoty1(ji,jj)+zoty1(ji+1,jj) & 2546 +zoty1(ji,jj-1)+zoty1(ji+1,jj-1)) 2547 ENDDO 2548 ENDDO 2549 2550 ! Ensure any N fold and wrap columns are updated 2551 CALL lbc_lnk(ztmp1, 'V', -1.0) 2552 CALL lbc_lnk(ztmp2, 'U', -1.0) 2553 2554 ikchoix = -1 2555 CALL repcmo (zotx1,ztmp2,ztmp1,zoty1,zotx1,zoty1,ikchoix) 2556 ENDIF 1965 2557 ENDIF 1966 2558 ! … … 2023 2615 IF( ssnd(jps_rnf )%laction ) CALL cpl_snd( jps_rnf , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info ) 2024 2616 IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 2025 2617 2618 #if defined key_cice 2619 ztmp1(:,:) = sstfrz(:,:) + rt0 2620 IF( ssnd(jps_sstfrz)%laction ) CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2621 #endif 2622 ! 2026 2623 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 2027 2624 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 )
Note: See TracChangeset
for help on using the changeset viewer.
