- Timestamp:
- 2017-12-13T15:58:53+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r8329 r9019 9 9 !! 3.4 ! 2011_11 (C. Harris) more flexibility + multi-category fields 10 10 !!---------------------------------------------------------------------- 11 11 12 !!---------------------------------------------------------------------- 12 13 !! namsbc_cpl : coupled formulation namlist … … 29 30 USE ice ! ice variables 30 31 #endif 31 #if defined key_lim232 USE par_ice_2 ! ice parameters33 USE ice_2 ! ice variables34 #endif35 32 USE cpl_oasis3 ! OASIS3 coupling 36 33 USE geo2ocean ! 37 USE oce , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev38 USE albedo!34 USE oce , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev 35 USE ocealb ! 39 36 USE eosbn2 ! 40 USE sbcrnf , ONLY : l_rnfcpl41 USE sbcisf 37 USE sbcrnf , ONLY : l_rnfcpl 38 USE sbcisf , ONLY : l_isfcpl 42 39 #if defined key_cice 43 40 USE ice_domain_size, only: ncat 44 41 #endif 45 42 #if defined key_lim3 46 USE limthd_dh ! for CALL lim_thd_snwblow43 USE icethd_dh ! for CALL ice_thd_snwblow 47 44 #endif 48 45 ! … … 50 47 USE iom ! NetCDF library 51 48 USE lib_mpp ! distribued memory computing library 52 USE wrk_nemo ! work arrays53 49 USE timing ! Timing 54 50 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 58 54 59 55 PUBLIC sbc_cpl_init ! routine called by sbcmod.F90 60 PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim(_2).F9056 PUBLIC sbc_cpl_rcv ! routine called by icestp.F90 61 57 PUBLIC sbc_cpl_snd ! routine called by step.F90 62 PUBLIC sbc_cpl_ice_tau ! routine called by sbc_ice_lim(_2).F9063 PUBLIC sbc_cpl_ice_flx ! routine called by sbc_ice_lim(_2).F9058 PUBLIC sbc_cpl_ice_tau ! routine called by icestp.F90 59 PUBLIC sbc_cpl_ice_flx ! routine called by icestp.F90 64 60 PUBLIC sbc_cpl_alloc ! routine called in sbcice_cice.F90 65 61 … … 117 113 INTEGER, PARAMETER :: jpr_isf = 52 118 114 INTEGER, PARAMETER :: jpr_icb = 53 119 120 INTEGER, PARAMETER :: jprcv = 53 ! total number of fields received 115 INTEGER, PARAMETER :: jpr_ts_ice = 54 ! Sea ice surface temp 116 117 INTEGER, PARAMETER :: jprcv = 54 ! total number of fields received 121 118 122 119 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere … … 152 149 INTEGER, PARAMETER :: jps_ocyw = 31 ! currents on grid 2 153 150 INTEGER, PARAMETER :: jps_wlev = 32 ! water level 154 INTEGER, PARAMETER :: jpsnd = 32 ! total number of fields sent 151 INTEGER, PARAMETER :: jps_fice1 = 33 ! first-order ice concentration (for semi-implicit coupling of atmos-ice fluxes) 152 INTEGER, PARAMETER :: jps_a_p = 34 ! meltpond area 153 INTEGER, PARAMETER :: jps_ht_p = 35 ! meltpond thickness 154 INTEGER, PARAMETER :: jps_kice = 36 ! sea ice effective conductivity 155 INTEGER, PARAMETER :: jps_sstfrz = 37 ! sea surface freezing temperature 156 INTEGER, PARAMETER :: jps_ttilyr = 38 ! sea ice top layer temp 157 158 INTEGER, PARAMETER :: jpsnd = 38 ! total number of fields sent 155 159 156 160 ! !!** namelist namsbc_cpl ** … … 163 167 END TYPE FLD_C 164 168 ! ! Send to the atmosphere 165 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2 169 TYPE(FLD_C) :: sn_snd_temp , sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, & 170 & sn_snd_thick1, sn_snd_cond, sn_snd_mpnd , sn_snd_sstfrz, sn_snd_ttilyr 166 171 ! ! Received from the atmosphere 167 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 168 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_mslp, sn_rcv_icb, sn_rcv_isf 172 TYPE(FLD_C) :: sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, & 173 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf, sn_rcv_ts_ice 174 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_mslp, sn_rcv_icb, sn_rcv_isf 169 175 ! Send to waves 170 176 TYPE(FLD_C) :: sn_snd_ifrac, sn_snd_crtw, sn_snd_wlev 171 177 ! Received from waves 172 TYPE(FLD_C) :: sn_rcv_hsig, sn_rcv_phioc,sn_rcv_sdrfx,sn_rcv_sdrfy,sn_rcv_wper,sn_rcv_wnum,sn_rcv_wstrf,sn_rcv_wdrag178 TYPE(FLD_C) :: sn_rcv_hsig, sn_rcv_phioc, sn_rcv_sdrfx, sn_rcv_sdrfy, sn_rcv_wper, sn_rcv_wnum, sn_rcv_wstrf, sn_rcv_wdrag 173 179 ! ! Other namelist parameters 174 180 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 175 181 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models 176 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel)182 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 177 183 TYPE :: DYNARR 178 REAL(wp), POINTER, DIMENSION(:,:,:) 184 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 179 185 END TYPE DYNARR 180 186 181 TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv 182 183 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky)187 TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv ! all fields recieved from the atmosphere 188 189 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: alb_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 184 190 185 191 REAL(wp) :: rpref = 101000._wp ! reference atmospheric pressure[N/m2] 186 192 REAL(wp) :: r1_grau ! = 1.e0 / (grav * rau0) 187 193 188 INTEGER , ALLOCATABLE, SAVE, DIMENSION( 194 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) :: nrcvinfo ! OASIS info argument 189 195 190 196 !! Substitution … … 205 211 ierr(:) = 0 206 212 ! 207 ALLOCATE( alb edo_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) )213 ALLOCATE( alb_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) ) 208 214 209 #if ! defined key_lim3 && ! defined key_ lim2 && ! defined key_cice215 #if ! defined key_lim3 && ! defined key_cice 210 216 ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 211 217 #endif … … 237 243 INTEGER :: jn ! dummy loop index 238 244 INTEGER :: ios, inum ! Local integer 239 REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos245 REAL(wp), DIMENSION(jpi,jpj) :: zacs, zaos 240 246 !! 241 NAMELIST/namsbc_cpl/ sn_snd_temp , sn_snd_alb , sn_snd_thick , sn_snd_crt , sn_snd_co2,&242 & sn_rcv_w10m , sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr,&243 & sn_snd_ifrac , sn_snd_crtw , sn_snd_wlev , sn_rcv_hsig , sn_rcv_phioc, &244 & sn_rcv_sdrfx , sn_rcv_sdrfy, sn_rcv_wper , sn_rcv_wnum , sn_rcv_wstrf, &245 & sn_rcv_wdrag , sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal, &246 & sn_rcv_iceflx, sn_rcv_co2 , nn_cplmodel , ln_usecplmask, sn_rcv_mslp, &247 & sn_rcv_icb , sn_rcv_isf247 NAMELIST/namsbc_cpl/ sn_snd_temp , sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2 , & 248 & sn_rcv_w10m , sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr , & 249 & sn_snd_ifrac , sn_snd_crtw , sn_snd_wlev , sn_rcv_hsig , sn_rcv_phioc, & 250 & sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum , sn_rcv_wstrf, & 251 & sn_rcv_wdrag , sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , & 252 & sn_rcv_iceflx, sn_rcv_co2 , nn_cplmodel , ln_usecplmask, sn_rcv_mslp , & 253 & sn_rcv_icb , sn_rcv_isf , nn_cats_cpl 248 254 249 255 !!--------------------------------------------------------------------- … … 251 257 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_init') 252 258 ! 253 CALL wrk_alloc( jpi,jpj, zacs, zaos )254 255 259 ! ================================ ! 256 260 ! Namelist informations ! … … 297 301 WRITE(numout,*)' Stress frac adsorbed by waves = ', TRIM(sn_rcv_wstrf%cldes ), ' (', TRIM(sn_rcv_wstrf%clcat ), ')' 298 302 WRITE(numout,*)' Neutral surf drag coefficient = ', TRIM(sn_rcv_wdrag%cldes ), ' (', TRIM(sn_rcv_wdrag%clcat ), ')' 303 WRITE(numout,*)' Sea ice surface skin temperature= ', TRIM(sn_rcv_ts_ice%cldes), ' (', TRIM(sn_rcv_ts_ice%clcat), ')' 299 304 WRITE(numout,*)' sent fields (multiple ice categories)' 300 305 WRITE(numout,*)' surface temperature = ', TRIM(sn_snd_temp%cldes ), ' (', TRIM(sn_snd_temp%clcat ), ')' 306 WRITE(numout,*)' top ice layer temperature = ', TRIM(sn_snd_ttilyr%cldes), ' (', TRIM(sn_snd_ttilyr%clcat), ')' 301 307 WRITE(numout,*)' albedo = ', TRIM(sn_snd_alb%cldes ), ' (', TRIM(sn_snd_alb%clcat ), ')' 302 308 WRITE(numout,*)' ice/snow thickness = ', TRIM(sn_snd_thick%cldes ), ' (', TRIM(sn_snd_thick%clcat ), ')' … … 307 313 WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd 308 314 WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')' 315 WRITE(numout,*)' ice effective conductivity = ', TRIM(sn_snd_cond%cldes ), ' (', TRIM(sn_snd_cond%clcat ), ')' 316 WRITE(numout,*)' meltponds fraction and depth = ', TRIM(sn_snd_mpnd%cldes ), ' (', TRIM(sn_snd_mpnd%clcat ), ')' 317 WRITE(numout,*)' sea surface freezing temp = ', TRIM(sn_snd_sstfrz%cldes), ' (', TRIM(sn_snd_sstfrz%clcat), ')' 309 318 WRITE(numout,*)' water level = ', TRIM(sn_snd_wlev%cldes ), ' (', TRIM(sn_snd_wlev%clcat ), ')' 310 319 WRITE(numout,*)' mean sea level pressure = ', TRIM(sn_rcv_mslp%cldes ), ' (', TRIM(sn_rcv_mslp%clcat ), ')' … … 315 324 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel 316 325 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask 326 WRITE(numout,*)' nn_cats_cpl = ', nn_cats_cpl 317 327 ENDIF 318 328 … … 435 445 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 436 446 CASE( 'none' ) ! nothing to do 437 CASE( 'oce only' ) ; srcv( jpr_oemp)%laction = .TRUE.447 CASE( 'oce only' ) ; srcv(jpr_oemp)%laction = .TRUE. 438 448 CASE( 'conservative' ) 439 449 srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. … … 479 489 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' ) 480 490 END SELECT 481 IF( TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) &491 IF( TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' .AND. nn_cats_cpl > 1 ) & 482 492 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qns%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 493 ! 483 494 ! ! ------------------------- ! 484 495 ! ! solar radiation ! Qsr … … 495 506 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' ) 496 507 END SELECT 497 IF( TRIM( sn_rcv_qsr%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) &508 IF( TRIM( sn_rcv_qsr%cldes ) == 'mixed oce-ice' .AND. nn_cats_cpl > 1 ) & 498 509 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qsr%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 510 ! 499 511 ! ! ------------------------- ! 500 512 ! ! non solar sensitivity ! d(Qns)/d(T) … … 503 515 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'coupled' ) srcv(jpr_dqnsdt)%laction = .TRUE. 504 516 ! 505 ! non solar sensitivity mandatory for LIM ice model506 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 .AND. nn_components /= jp_iam_sas ) &507 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' )508 517 ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique 509 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' ) & 510 CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between sn_rcv_qns%cldes and sn_rcv_dqnsdt%cldes' ) 518 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' ) & 519 & CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between sn_rcv_qns%cldes and sn_rcv_dqnsdt%cldes' ) 520 ! 511 521 ! ! ------------------------- ! 512 522 ! ! 10m wind module ! … … 519 529 srcv(jpr_taum)%clname = 'O_TauMod' ; IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' ) srcv(jpr_taum)%laction = .TRUE. 520 530 lhftau = srcv(jpr_taum)%laction 521 531 ! 522 532 ! ! ------------------------- ! 523 533 ! ! Atmospheric CO2 ! … … 531 541 IF(lwp) WRITE(numout,*) 532 542 ENDIF 533 543 ! 534 544 ! ! ------------------------- ! 535 545 ! ! Mean Sea Level Pressure ! 536 546 ! ! ------------------------- ! 537 547 srcv(jpr_mslp)%clname = 'O_MSLP' ; IF( TRIM(sn_rcv_mslp%cldes ) == 'coupled' ) srcv(jpr_mslp)%laction = .TRUE. 538 539 ! ! ------------------------- ! 540 ! ! topmelt and botmelt!548 ! 549 ! ! ------------------------- ! 550 ! ! ice topmelt and botmelt ! 541 551 ! ! ------------------------- ! 542 552 srcv(jpr_topm )%clname = 'OTopMlt' … … 544 554 IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 545 555 IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN 546 srcv(jpr_topm:jpr_botm)%nct = jpl556 srcv(jpr_topm:jpr_botm)%nct = nn_cats_cpl 547 557 ELSE 548 558 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_iceflx%clcat should always be set to yes currently' ) … … 550 560 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 551 561 ENDIF 562 ! ! ------------------------- ! 563 ! ! ice skin temperature ! 564 ! ! ------------------------- ! 565 srcv(jpr_ts_ice)%clname = 'OTsfIce' ! needed by Met Office 566 IF ( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' ) srcv(jpr_ts_ice)%laction = .TRUE. 567 IF ( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' ) srcv(jpr_ts_ice)%nct = nn_cats_cpl 568 IF ( TRIM( sn_rcv_emp%clcat ) == 'yes' ) srcv(jpr_ievp)%nct = nn_cats_cpl 569 552 570 ! ! ------------------------- ! 553 571 ! ! Wave breaking ! … … 593 611 cpl_wdrag = .TRUE. 594 612 ENDIF 595 !596 613 ! ! ------------------------------- ! 597 614 ! ! OPA-SAS coupling - rcv by opa ! … … 710 727 ! ! Surface temperature ! 711 728 ! ! ------------------------- ! 712 ssnd(jps_toce)%clname = 'O_SSTSST' 713 ssnd(jps_tice)%clname = 'O_TepIce' 714 ssnd(jps_tmix)%clname = 'O_TepMix' 729 ssnd(jps_toce)%clname = 'O_SSTSST' 730 ssnd(jps_tice)%clname = 'O_TepIce' 731 ssnd(jps_ttilyr)%clname = 'O_TtiLyr' 732 ssnd(jps_tmix)%clname = 'O_TepMix' 715 733 SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 716 734 CASE( 'none' ) ! nothing to do 717 735 CASE( 'oce only' ) ; ssnd( jps_toce )%laction = .TRUE. 718 CASE( 'oce and ice' , 'weighted oce and ice' )736 CASE( 'oce and ice' , 'weighted oce and ice' , 'oce and weighted ice' ) 719 737 ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 720 IF ( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = jpl738 IF ( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = nn_cats_cpl 721 739 CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix )%laction = .TRUE. 722 740 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) … … 739 757 ! 2. receiving mixed oce-ice solar radiation 740 758 IF ( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN 741 CALL albedo_oce( zaos, zacs )759 CALL oce_alb( zaos, zacs ) 742 760 ! Due to lack of information on nebulosity : mean clear/overcast sky 743 albedo_oce_mix(:,:) = ( zacs(:,:) + zaos(:,:) ) * 0.5 744 ENDIF 745 761 alb_oce_mix(:,:) = ( zacs(:,:) + zaos(:,:) ) * 0.5 762 ENDIF 746 763 ! ! ------------------------- ! 747 764 ! ! Ice fraction & Thickness ! 748 765 ! ! ------------------------- ! 749 ssnd(jps_fice)%clname = 'OIceFrc'766 ssnd(jps_fice)%clname = 'OIceFrc' 750 767 ssnd(jps_ficet)%clname = 'OIceFrcT' 751 ssnd(jps_hice)%clname = 'OIceTck' 752 ssnd(jps_hsnw)%clname = 'OSnwTck' 768 ssnd(jps_hice)%clname = 'OIceTck' 769 ssnd(jps_a_p)%clname = 'OPndFrc' 770 ssnd(jps_ht_p)%clname = 'OPndTck' 771 ssnd(jps_hsnw)%clname = 'OSnwTck' 772 ssnd(jps_fice1)%clname = 'OIceFrd' 753 773 IF( k_ice /= 0 ) THEN 754 ssnd(jps_fice)%laction = .TRUE. ! if ice treated in the ocean (even in climato case) 774 ssnd(jps_fice)%laction = .TRUE. ! if ice treated in the ocean (even in climato case) 775 ssnd(jps_fice1)%laction = .TRUE. ! First-order regridded ice concentration, to be used producing atmos-to-ice fluxes (Met Office requirement) 755 776 ! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now 756 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 777 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = nn_cats_cpl 778 IF ( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = nn_cats_cpl 757 779 ENDIF 758 780 … … 764 786 ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 765 787 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 766 ssnd(jps_hice:jps_hsnw)%nct = jpl788 ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl 767 789 ENDIF 768 790 CASE ( 'weighted ice and snow' ) 769 791 ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 770 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = jpl792 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl 771 793 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' ) 772 794 END SELECT 773 795 796 ! ! ------------------------- ! 797 ! ! Ice Meltponds ! 798 ! ! ------------------------- ! 799 ! Needed by Met Office 800 ssnd(jps_a_p)%clname = 'OPndFrc' 801 ssnd(jps_ht_p)%clname = 'OPndTck' 802 SELECT CASE ( TRIM( sn_snd_mpnd%cldes ) ) 803 CASE ( 'none' ) 804 ssnd(jps_a_p)%laction = .FALSE. 805 ssnd(jps_ht_p)%laction = .FALSE. 806 CASE ( 'ice only' ) 807 ssnd(jps_a_p)%laction = .TRUE. 808 ssnd(jps_ht_p)%laction = .TRUE. 809 IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 810 ssnd(jps_a_p)%nct = nn_cats_cpl 811 ssnd(jps_ht_p)%nct = nn_cats_cpl 812 ELSE 813 IF ( nn_cats_cpl > 1 ) THEN 814 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' ) 815 ENDIF 816 ENDIF 817 CASE ( 'weighted ice' ) 818 ssnd(jps_a_p)%laction = .TRUE. 819 ssnd(jps_ht_p)%laction = .TRUE. 820 IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 821 ssnd(jps_a_p)%nct = nn_cats_cpl 822 ssnd(jps_ht_p)%nct = nn_cats_cpl 823 ENDIF 824 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_mpnd%cldes; '//sn_snd_mpnd%cldes ) 825 END SELECT 826 774 827 ! ! ------------------------- ! 775 828 ! ! Surface current ! … … 821 874 ! ! ------------------------- ! 822 875 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 823 876 ! 877 ! ! ------------------------- ! 878 ! ! Sea surface freezing temp ! 879 ! ! ------------------------- ! 880 ! needed by Met Office 881 ssnd(jps_sstfrz)%clname = 'O_SSTFrz' ; IF( TRIM(sn_snd_sstfrz%cldes) == 'coupled' ) ssnd(jps_sstfrz)%laction = .TRUE. 882 ! 883 ! ! ------------------------- ! 884 ! ! Ice conductivity ! 885 ! ! ------------------------- ! 886 ! needed by Met Office 887 ! Note that ultimately we will move to passing an ocean effective conductivity as well so there 888 ! will be some changes to the parts of the code which currently relate only to ice conductivity 889 ssnd(jps_ttilyr )%clname = 'O_TtiLyr' 890 SELECT CASE ( TRIM( sn_snd_ttilyr%cldes ) ) 891 CASE ( 'none' ) 892 ssnd(jps_ttilyr)%laction = .FALSE. 893 CASE ( 'ice only' ) 894 ssnd(jps_ttilyr)%laction = .TRUE. 895 IF ( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN 896 ssnd(jps_ttilyr)%nct = nn_cats_cpl 897 ELSE 898 IF ( nn_cats_cpl > 1 ) THEN 899 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_ttilyr%cldes if not exchanging category fields' ) 900 ENDIF 901 ENDIF 902 CASE ( 'weighted ice' ) 903 ssnd(jps_ttilyr)%laction = .TRUE. 904 IF ( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl 905 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_ttilyr%cldes;'//sn_snd_ttilyr%cldes ) 906 END SELECT 907 908 ssnd(jps_kice )%clname = 'OIceKn' 909 SELECT CASE ( TRIM( sn_snd_cond%cldes ) ) 910 CASE ( 'none' ) 911 ssnd(jps_kice)%laction = .FALSE. 912 CASE ( 'ice only' ) 913 ssnd(jps_kice)%laction = .TRUE. 914 IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN 915 ssnd(jps_kice)%nct = nn_cats_cpl 916 ELSE 917 IF ( nn_cats_cpl > 1 ) THEN 918 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' ) 919 ENDIF 920 ENDIF 921 CASE ( 'weighted ice' ) 922 ssnd(jps_kice)%laction = .TRUE. 923 IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl 924 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes;'//sn_snd_cond%cldes ) 925 END SELECT 926 ! 824 927 ! ! ------------------------- ! 825 928 ! ! Sea surface height ! … … 922 1025 IF( ln_dm2dc .AND. ln_cpl ) ncpl_qsr_freq = 86400 / ncpl_qsr_freq 923 1026 924 CALL wrk_dealloc( jpi,jpj, zacs, zaos )925 1027 ! 926 1028 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_init') … … 974 1076 !! emp upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case) 975 1077 !!---------------------------------------------------------------------- 976 USE zdf_oce, ONLY : ln_zdfqiao 977 978 IMPLICIT NONE 979 980 INTEGER, INTENT(in) :: kt ! ocean model time step index 981 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 982 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 1078 USE zdf_oce, ONLY : ln_zdfswm 1079 ! 1080 INTEGER, INTENT(in) :: kt ! ocean model time step index 1081 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 1082 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 983 1083 !! 984 1084 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? … … 990 1090 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 991 1091 REAL(wp) :: zzx, zzy ! temporary variables 992 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr1092 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr 993 1093 !!---------------------------------------------------------------------- 994 1094 ! 995 1095 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') 996 !997 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )998 1096 ! 999 1097 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1067 1165 ! ! wind stress module ! (taum) 1068 1166 ! ! ========================= ! 1069 !1070 1167 IF( .NOT. srcv(jpr_taum)%laction ) THEN ! compute wind stress module from its components if not received 1071 1168 ! => need to be done only when otx1 was changed … … 1094 1191 ! ! 10 m wind speed ! (wndm) 1095 1192 ! ! ========================= ! 1096 !1097 1193 IF( .NOT. srcv(jpr_w10m)%laction ) THEN ! compute wind spreed from wind stress module if not received 1098 1194 ! => need to be done only when taumod was changed … … 1130 1226 ! ! ================== ! 1131 1227 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 1132 ! 1228 ! 1229 ! ! ================== ! 1230 ! ! ice skin temp. ! 1231 ! ! ================== ! 1232 #if defined key_lim3 1233 ! needed by Met Office 1234 IF( srcv(jpr_ts_ice)%laction ) THEN 1235 WHERE ( frcv(jpr_ts_ice)%z3(:,:,:) > 0.0 ) ; tsfc_ice(:,:,:) = 0.0 1236 ELSEWHERE( frcv(jpr_ts_ice)%z3(:,:,:) < -60. ) ; tsfc_ice(:,:,:) = -60. 1237 ELSEWHERE ; tsfc_ice(:,:,:) = frcv(jpr_ts_ice)%z3(:,:,:) 1238 END WHERE 1239 ENDIF 1240 #endif 1133 1241 ! ! ========================= ! 1134 1242 ! ! Mean Sea Level Pressure ! (taum) 1135 1243 ! ! ========================= ! 1136 !1137 1244 IF( srcv(jpr_mslp)%laction ) THEN ! UKMO SHELF effect of atmospheric pressure on SSH 1138 1245 IF( kt /= nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) !* Swap of ssh_ib fields … … 1146 1253 ! 1147 1254 IF( ln_sdw ) THEN ! Stokes Drift correction activated 1148 !! ========================= !1149 !! Stokes drift u !1150 !! ========================= !1151 IF( srcv(jpr_sdrftx)%laction ) ut0sd(:,:) = frcv(jpr_sdrftx)%z3(:,:,1)1152 !1153 !! ========================= !1154 !! Stokes drift v !1155 !! ========================= !1156 IF( srcv(jpr_sdrfty)%laction ) vt0sd(:,:) = frcv(jpr_sdrfty)%z3(:,:,1)1157 !1158 !! ========================= !1159 !! Wave mean period !1160 !! ========================= !1161 IF( srcv(jpr_wper)%laction )wmp(:,:) = frcv(jpr_wper)%z3(:,:,1)1162 !1163 !! ========================= !1164 !! Significant wave height !1165 !! ========================= !1166 IF( srcv(jpr_hsig)%laction )hsw(:,:) = frcv(jpr_hsig)%z3(:,:,1)1167 !1168 !! ========================= !1169 ! ! Vertical mixing Qiao!1170 !! ========================= !1171 IF( srcv(jpr_wnum)%laction .AND. ln_zdf qiao )wnum(:,:) = frcv(jpr_wnum)%z3(:,:,1)1255 ! ! ========================= ! 1256 ! ! Stokes drift u ! 1257 ! ! ========================= ! 1258 IF( srcv(jpr_sdrftx)%laction ) ut0sd(:,:) = frcv(jpr_sdrftx)%z3(:,:,1) 1259 ! 1260 ! ! ========================= ! 1261 ! ! Stokes drift v ! 1262 ! ! ========================= ! 1263 IF( srcv(jpr_sdrfty)%laction ) vt0sd(:,:) = frcv(jpr_sdrfty)%z3(:,:,1) 1264 ! 1265 ! ! ========================= ! 1266 ! ! Wave mean period ! 1267 ! ! ========================= ! 1268 IF( srcv(jpr_wper)%laction ) wmp(:,:) = frcv(jpr_wper)%z3(:,:,1) 1269 ! 1270 ! ! ========================= ! 1271 ! ! Significant wave height ! 1272 ! ! ========================= ! 1273 IF( srcv(jpr_hsig)%laction ) hsw(:,:) = frcv(jpr_hsig)%z3(:,:,1) 1274 ! 1275 ! ! ========================= ! 1276 ! ! surface wave mixing ! 1277 ! ! ========================= ! 1278 IF( srcv(jpr_wnum)%laction .AND. ln_zdfswm ) wnum(:,:) = frcv(jpr_wnum)%z3(:,:,1) 1172 1279 1173 1280 ! Calculate the 3D Stokes drift both in coupled and not fully uncoupled mode 1174 1281 IF( srcv(jpr_sdrftx)%laction .OR. srcv(jpr_sdrfty)%laction .OR. srcv(jpr_wper)%laction & 1175 1282 & .OR. srcv(jpr_hsig)%laction ) THEN 1176 1283 CALL sbc_stokes() 1177 1284 ENDIF … … 1180 1287 ! ! Stress adsorbed by waves ! 1181 1288 ! ! ========================= ! 1182 IF( srcv(jpr_wstrf)%laction .AND. ln_tauoc ) tauoc_wave(:,:) = frcv(jpr_wstrf)%z3(:,:,1)1289 IF( srcv(jpr_wstrf)%laction .AND. ln_tauoc ) tauoc_wave(:,:) = frcv(jpr_wstrf)%z3(:,:,1) 1183 1290 1184 1291 ! ! ========================= ! 1185 1292 ! ! Wave drag coefficient ! 1186 1293 ! ! ========================= ! 1187 IF( srcv(jpr_wdrag)%laction .AND. ln_cdgw ) cdn_wave(:,:) = frcv(jpr_wdrag)%z3(:,:,1)1294 IF( srcv(jpr_wdrag)%laction .AND. ln_cdgw ) cdn_wave(:,:) = frcv(jpr_wdrag)%z3(:,:,1) 1188 1295 1189 1296 ! Fields received by SAS when OASIS coupling … … 1218 1325 IF( srcv(jpr_ocx1)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1219 1326 ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 1220 ub (:,:,1) = ssu_m(:,:) ! will be used in sbcice_limin the call of lim_sbc_tau1327 ub (:,:,1) = ssu_m(:,:) ! will be used in icestp in the call of lim_sbc_tau 1221 1328 un (:,:,1) = ssu_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1222 1329 CALL iom_put( 'ssu_m', ssu_m ) … … 1224 1331 IF( srcv(jpr_ocy1)%laction ) THEN 1225 1332 ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 1226 vb (:,:,1) = ssv_m(:,:) ! will be used in sbcice_limin the call of lim_sbc_tau1333 vb (:,:,1) = ssv_m(:,:) ! will be used in icestp in the call of lim_sbc_tau 1227 1334 vn (:,:,1) = ssv_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1228 1335 CALL iom_put( 'ssv_m', ssv_m ) … … 1310 1417 ! 1311 1418 ENDIF 1312 !1313 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )1314 1419 ! 1315 1420 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv') … … 1356 1461 INTEGER :: ji, jj ! dummy loop indices 1357 1462 INTEGER :: itx ! index of taux over ice 1358 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty1463 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty 1359 1464 !!---------------------------------------------------------------------- 1360 1465 ! 1361 1466 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_tau') 1362 1467 ! 1363 CALL wrk_alloc( jpi,jpj, ztx, zty )1364 1365 1468 IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1 1366 1469 ELSE ; itx = jpr_otx1 … … 1521 1624 ENDIF 1522 1625 ! 1523 CALL wrk_dealloc( jpi,jpj, ztx, zty )1524 !1525 1626 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_tau') 1526 1627 ! … … 1528 1629 1529 1630 1530 SUBROUTINE sbc_cpl_ice_flx( p _frld, palbi, psst, pist)1631 SUBROUTINE sbc_cpl_ice_flx( picefr, palbi, psst, pist, phs, phi ) 1531 1632 !!---------------------------------------------------------------------- 1532 1633 !! *** ROUTINE sbc_cpl_ice_flx *** … … 1561 1662 !! 1562 1663 !! ** Details 1563 !! qns_tot = pfrld * qns_oce + ( 1 - pfrld ) * qns_ice=> provided1664 !! qns_tot = (1-a) * qns_oce + a * qns_ice => provided 1564 1665 !! + qemp_oce + qemp_ice => recalculated and added up to qns 1565 1666 !! 1566 !! qsr_tot = pfrld * qsr_oce + ( 1 - pfrld ) * qsr_ice=> provided1667 !! qsr_tot = (1-a) * qsr_oce + a * qsr_ice => provided 1567 1668 !! 1568 1669 !! emp_tot = emp_oce + emp_ice => calving is provided and added to emp_tot (and emp_oce). … … 1578 1679 !! sprecip solid precipitation over the ocean 1579 1680 !!---------------------------------------------------------------------- 1580 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] 1581 ! optional arguments, used only in 'mixed oce-ice' case 1582 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1583 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1584 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1585 ! 1586 INTEGER :: jl ! dummy loop index 1587 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, zcptrain, zcptsnw, zicefr, zmsk, zsnw 1588 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice 1589 REAL(wp), POINTER, DIMENSION(:,: ) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1590 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice 1681 REAL(wp), INTENT(in), DIMENSION(:,:) :: picefr ! ice fraction [0 to 1] 1682 ! !! ! optional arguments, used only in 'mixed oce-ice' case 1683 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1684 REAL(wp), INTENT(in), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1685 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1686 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: phs ! snow depth [m] 1687 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: phi ! ice thickness [m] 1688 ! 1689 INTEGER :: ji, jj, jl ! dummy loop index 1690 REAL(wp) :: ztri ! local scalar 1691 REAL(wp), DIMENSION(jpi,jpj) :: zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw 1692 REAL(wp), DIMENSION(jpi,jpj) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip , zevap_oce, zdevap_ice 1693 REAL(wp), DIMENSION(jpi,jpj) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1694 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice !!gm , zfrqsr_tr_i 1591 1695 !!---------------------------------------------------------------------- 1592 1696 ! 1593 1697 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx') 1594 1698 ! 1595 CALL wrk_alloc( jpi,jpj, zcptn, zcptrain, zcptsnw, zicefr, zmsk, zsnw )1596 CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice )1597 CALL wrk_alloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice )1598 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice )1599 1600 1699 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) 1601 zice fr(:,:) = 1.- p_frld(:,:)1602 zcptn (:,:) = rcp * sst_m(:,:)1700 ziceld(:,:) = 1._wp - picefr(:,:) 1701 zcptn (:,:) = rcp * sst_m(:,:) 1603 1702 ! 1604 1703 ! ! ========================= ! … … 1615 1714 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1616 1715 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1617 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * zicefr(:,:)1716 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:) 1618 1717 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1619 zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)1620 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * zicefr(:,:)1718 zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1719 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * picefr(:,:) 1621 1720 zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 1622 1721 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) … … 1624 1723 1625 1724 #if defined key_lim3 1626 ! zsnw = snow fraction over ice after wind blowing (= zicefr if no blowing)1627 zsnw(:,:) = 0._wp ; CALL lim_thd_snwblow( p_frld, zsnw )1725 ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing) 1726 zsnw(:,:) = 0._wp ; CALL ice_thd_snwblow( ziceld, zsnw ) 1628 1727 1629 1728 ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- ! 1630 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( zicefr(:,:) - zsnw(:,:) ) ! emp_ice = A * sublimation - zsnw * sprecip1729 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( picefr(:,:) - zsnw(:,:) ) ! emp_ice = A * sublimation - zsnw * sprecip 1631 1730 zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) ! emp_oce = emp_tot - emp_ice 1632 1731 1633 1732 ! --- evaporation over ocean (used later for qemp) --- ! 1634 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:)1733 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) 1635 1734 1636 1735 ! --- evaporation over ice (kg/m2/s) --- ! 1637 zevap_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) 1736 DO jl=1,jpl 1737 IF (sn_rcv_emp%clcat == 'yes') THEN ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 1738 ELSE ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,1 ) ; ENDIF 1739 ENDDO 1740 1638 1741 ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 1639 1742 ! therefore, sublimation is not redistributed over the ice categories when no subgrid scale fluxes are provided by atm. … … 1662 1765 sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1663 1766 tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1664 DO jl =1,jpl1665 evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,: ) * zmsk(:,:)1666 devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:) * zmsk(:,:)1667 END DO1767 DO jl = 1, jpl 1768 evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:,jl) * zmsk(:,:) 1769 devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:) * zmsk(:,:) 1770 END DO 1668 1771 ELSE 1669 emp_tot (:,:) = zemp_tot(:,:)1670 emp_ice (:,:) = zemp_ice(:,:)1671 emp_oce (:,:) = zemp_oce(:,:)1672 sprecip (:,:) = zsprecip(:,:)1673 tprecip (:,:) = ztprecip(:,:)1674 DO jl=1,jpl1675 evap_ice (:,:,jl) = zevap_ice (:,:)1772 emp_tot (:,:) = zemp_tot (:,:) 1773 emp_ice (:,:) = zemp_ice (:,:) 1774 emp_oce (:,:) = zemp_oce (:,:) 1775 sprecip (:,:) = zsprecip (:,:) 1776 tprecip (:,:) = ztprecip (:,:) 1777 evap_ice(:,:,:) = zevap_ice(:,:,:) 1778 DO jl = 1, jpl 1676 1779 devap_ice(:,:,jl) = zdevap_ice(:,:) 1677 END DO1780 END DO 1678 1781 ENDIF 1679 1782 1680 1783 #else 1681 zsnw(:,:) = zicefr(:,:)1784 zsnw(:,:) = picefr(:,:) 1682 1785 ! --- Continental fluxes --- ! 1683 1786 IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on) … … 1694 1797 fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1) 1695 1798 ENDIF 1696 1799 ! 1697 1800 IF( ln_mixcpl ) THEN 1698 1801 emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) … … 1706 1809 tprecip(:,:) = ztprecip(:,:) 1707 1810 ENDIF 1708 1811 ! 1709 1812 #endif 1813 1710 1814 ! outputs 1711 1815 !! IF( srcv(jpr_rnf)%laction ) CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1) ) ! runoff … … 1718 1822 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1719 1823 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1720 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average)1824 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average) 1721 1825 IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) & 1722 & - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average)1826 & - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1723 1827 ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf 1724 1828 ! … … 1733 1837 zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1734 1838 ELSE 1735 DO jl =1,jpl1839 DO jl = 1, jpl 1736 1840 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) ! Set all category values equal 1737 END DO1841 END DO 1738 1842 ENDIF 1739 1843 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1740 zqns_tot(:,:) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)1844 zqns_tot(:,:) = ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1741 1845 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1742 1846 DO jl=1,jpl … … 1745 1849 ENDDO 1746 1850 ELSE 1747 qns_tot(:,:) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1748 DO jl =1,jpl1749 zqns_tot(:,: ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1851 qns_tot(:,:) = qns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1852 DO jl = 1, jpl 1853 zqns_tot(:,: ) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1750 1854 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1751 END DO1855 END DO 1752 1856 ENDIF 1753 1857 CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations … … 1755 1859 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1756 1860 zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1757 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) &1758 & + pist(:,:,1) * zicefr(:,:) ) )1861 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * ziceld(:,:) & 1862 & + pist(:,:,1) * picefr(:,:) ) ) 1759 1863 END SELECT 1760 1864 ! … … 1767 1871 #if defined key_lim3 1768 1872 ! --- non solar flux over ocean --- ! 1769 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax1873 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax 1770 1874 zqns_oce = 0._wp 1771 WHERE( p_frld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:)1875 WHERE( ziceld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / ziceld(:,:) 1772 1876 1773 1877 ! Heat content per unit mass of snow (J/kg) … … 1776 1880 ENDWHERE 1777 1881 ! Heat content per unit mass of rain (J/kg) 1778 zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * p_frld(:,:) )1882 zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * ziceld(:,:) ) 1779 1883 1780 1884 ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! … … 1791 1895 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - lfus ) ! solid precip over ocean + snow melting 1792 1896 zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptsnw (:,:) - lfus ) ! solid precip over ice (qevap_ice=0 since atm. does not take it into account) 1793 !! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptsnw (:,:) & ! ice evap1897 !! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * zcptsnw (:,:) & ! ice evap 1794 1898 !! & + zsprecip(:,:) * zsnw * zqprec_ice(:,:) * r1_rhosn ! solid precip over ice 1795 1899 … … 1824 1928 ! clem: this formulation is certainly wrong... but better than it was... 1825 1929 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 1826 & - ( p_frld(:,:) * zsprecip(:,:) * lfus ) & ! remove the latent heat flux of solid precip. melting1930 & - ( ziceld(:,:) * zsprecip(:,:) * lfus ) & ! remove the latent heat flux of solid precip. melting 1827 1931 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1828 1932 & - zemp_ice(:,:) ) * zcptn(:,:) 1829 1933 1830 1934 IF( ln_mixcpl ) THEN 1831 qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk1935 qns_tot(:,:) = qns(:,:) * ziceld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1832 1936 qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 1833 1937 DO jl=1,jpl … … 1841 1945 #endif 1842 1946 ! outputs 1843 IF( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , & 1844 & - frcv(jpr_cal)%z3(:,:,1) * lfus) ! latent heat from calving 1845 IF( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * lfus) ! latent heat from icebergs melting 1846 IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea', sprecip(:,:) * ( zcptsnw(:,:) - Lfus )) ! heat flux from snow (cell average) 1847 IF( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea',( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:)) ! heat flux from rain (cell average) 1848 IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea',(frcv(jpr_tevp)%z3(:,:,1) & 1849 & - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) & ! heat flux from from evap (cell average) 1947 IF( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * lfus ) ! latent heat from calving 1948 IF( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * lfus ) ! latent heat from icebergs melting 1949 IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea', sprecip(:,:) * ( zcptsnw(:,:) - Lfus ) ) ! heat flux from snow (cell average) 1950 IF( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea',( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) ! heat flux from rain (cell average) 1951 IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea',(frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) & ! heat flux from from evap (cell average) 1850 1952 & ) * zcptn(:,:) * tmask(:,:,1) ) 1851 IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea',sprecip(:,:) & 1852 & * (zcptsnw(:,:) - Lfus) * (1._wp - zsnw(:,:)) ) ! heat flux from snow (over ocean) 1853 IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea',sprecip(:,:) * (zcptsnw(:,:) - Lfus) & 1854 & * zsnw(:,:) ) ! heat flux from snow (over ice) 1953 IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea',sprecip(:,:) * (zcptsnw(:,:) - Lfus) * (1._wp - zsnw(:,:)) ) ! heat flux from snow (over ocean) 1954 IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea',sprecip(:,:) * (zcptsnw(:,:) - Lfus) * zsnw(:,:) ) ! heat flux from snow (over ice) 1855 1955 ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp. 1856 1956 ! … … 1866 1966 ELSE 1867 1967 ! Set all category values equal for the moment 1868 DO jl =1,jpl1968 DO jl = 1, jpl 1869 1969 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1870 END DO1970 END DO 1871 1971 ENDIF 1872 1972 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1873 1973 zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 1874 1974 CASE( 'oce and ice' ) 1875 zqsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)1975 zqsr_tot(:,: ) = ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 1876 1976 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1877 DO jl =1,jpl1977 DO jl = 1, jpl 1878 1978 zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl) 1879 1979 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 1880 END DO1980 END DO 1881 1981 ELSE 1882 qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)1883 DO jl =1,jpl1884 zqsr_tot(:,: ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)1982 qsr_tot(:,: ) = qsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1983 DO jl = 1, jpl 1984 zqsr_tot(:,: ) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1885 1985 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1886 END DO1986 END DO 1887 1987 ENDIF 1888 1988 CASE( 'mixed oce-ice' ) … … 1892 1992 ! ( see OASIS3 user guide, 5th edition, p39 ) 1893 1993 zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) & 1894 & / ( 1.- ( alb edo_oce_mix(:,: ) * p_frld(:,:) &1895 & + palbi (:,:,1) * zicefr(:,:) ) )1994 & / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) & 1995 & + palbi (:,:,1) * picefr(:,:) ) ) 1896 1996 END SELECT 1897 1997 IF( ln_dm2dc .AND. ln_cpl ) THEN ! modify qsr to include the diurnal cycle 1898 1998 zqsr_tot(:,: ) = sbc_dcy( zqsr_tot(:,: ) ) 1899 DO jl =1,jpl1999 DO jl = 1, jpl 1900 2000 zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) ) 1901 END DO2001 END DO 1902 2002 ENDIF 1903 2003 1904 2004 #if defined key_lim3 1905 2005 ! --- solar flux over ocean --- ! 1906 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax2006 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax 1907 2007 zqsr_oce = 0._wp 1908 WHERE( p_frld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / p_frld(:,:)2008 WHERE( ziceld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:) 1909 2009 1910 2010 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:) … … 1913 2013 1914 2014 IF( ln_mixcpl ) THEN 1915 qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk2015 qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1916 2016 qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:)* zmsk(:,:) 1917 DO jl =1,jpl2017 DO jl = 1, jpl 1918 2018 qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) + zqsr_ice(:,:,jl)* zmsk(:,:) 1919 END DO2019 END DO 1920 2020 ELSE 1921 2021 qsr_tot(:,: ) = zqsr_tot(:,: ) … … 1944 2044 dqns_ice(:,:,:) = zdqns_ice(:,:,:) 1945 2045 ENDIF 1946 2046 2047 #if defined key_lim3 1947 2048 ! ! ========================= ! 1948 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! topmelt and botmelt!2049 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! ice topmelt and botmelt ! 1949 2050 ! ! ========================= ! 1950 2051 CASE ('coupled') 1951 topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:)1952 botmelt(:,:,:)=frcv(jpr_botm)%z3(:,:,:)2052 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i(:,:,:) 2053 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i(:,:,:) 1953 2054 END SELECT 1954 1955 ! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 ) 1956 ! Used for LIM2 and LIM3 1957 ! Coupled case: since cloud cover is not received from atmosphere 1958 ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 1959 fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 1960 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1961 1962 CALL wrk_dealloc( jpi,jpj, zcptn, zcptrain, zcptsnw, zicefr, zmsk, zsnw ) 1963 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 1964 CALL wrk_dealloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1965 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) 1966 ! 2055 ! 2056 ! ! ========================= ! 2057 ! ! Transmitted Qsr ! [W/m2] 2058 ! ! ========================= ! 2059 SELECT CASE( nice_jules ) 2060 CASE( np_jules_OFF ) !== No Jules coupler ==! 2061 ! 2062 ! ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 2063 ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ! surface transmission parameter (Grenfell Maykut 77) 2064 ! 2065 qsr_ice_tr(:,:,:) = ztri * qsr_ice(:,:,:) 2066 WHERE( phs(:,:,:) >= 0.0_wp ) qsr_ice_tr(:,:,:) = 0._wp ! snow fully opaque 2067 WHERE( phi(:,:,:) <= 0.1_wp ) qsr_ice_tr(:,:,:) = qsr_ice(:,:,:) ! thin ice transmits all solar radiation 2068 ! 2069 CASE( np_jules_ACTIVE ) !== Jules coupler is active ==! 2070 ! 2071 ! ! ===> here we must receive the qsr_ice_tr array from the coupler 2072 ! for now just assume zero (fully opaque ice) 2073 qsr_ice_tr(:,:,:) = 0._wp 2074 ! 2075 END SELECT 2076 ! 2077 #endif 1967 2078 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx') 1968 2079 ! … … 1984 2095 INTEGER :: isec, info ! local integer 1985 2096 REAL(wp) :: zumax, zvmax 1986 REAL(wp), POINTER, DIMENSION(:,:):: zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz11987 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmp3, ztmp42097 REAL(wp), DIMENSION(jpi,jpj) :: zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 2098 REAL(wp), DIMENSION(jpi,jpj,jpl) :: ztmp3, ztmp4 1988 2099 !!---------------------------------------------------------------------- 1989 2100 ! 1990 2101 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_snd') 1991 2102 ! 1992 CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )1993 CALL wrk_alloc( jpi,jpj,jpl, ztmp3, ztmp4 )1994 1995 2103 isec = ( kt - nit000 ) * NINT( rdt ) ! date of exchanges 1996 2104 … … 2006 2114 ! we must send the surface potential temperature 2007 2115 IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 2008 ELSE 2116 ELSE ; ztmp1(:,:) = tsn(:,:,1,jp_tem) 2009 2117 ENDIF 2010 2118 ! … … 2034 2142 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 2035 2143 END SELECT 2144 CASE( 'oce and weighted ice') ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0 2145 SELECT CASE( sn_snd_temp%clcat ) 2146 CASE( 'yes' ) 2147 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2148 CASE( 'no' ) 2149 ztmp3(:,:,:) = 0.0 2150 DO jl=1,jpl 2151 ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 2152 ENDDO 2153 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 2154 END SELECT 2036 2155 CASE( 'mixed oce-ice' ) 2037 2156 ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) … … 2046 2165 IF( ssnd(jps_tmix)%laction ) CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2047 2166 ENDIF 2167 ! 2168 ! ! ------------------------- ! 2169 ! ! 1st layer ice/snow temp. ! 2170 ! ! ------------------------- ! 2171 #if defined key_lim3 2172 ! needed by Met Office 2173 IF( ssnd(jps_ttilyr)%laction) THEN 2174 SELECT CASE( sn_snd_ttilyr%cldes) 2175 CASE ('weighted ice') 2176 ztmp3(:,:,1:jpl) = t1_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2177 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ttilyr%cldes' ) 2178 END SELECT 2179 IF( ssnd(jps_ttilyr)%laction ) CALL cpl_snd( jps_ttilyr, isec, ztmp3, info ) 2180 ENDIF 2181 #endif 2048 2182 ! ! ------------------------- ! 2049 2183 ! ! Albedo ! … … 2059 2193 ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 ) 2060 2194 ELSEWHERE 2061 ztmp1(:,:) = alb edo_oce_mix(:,:)2195 ztmp1(:,:) = alb_oce_mix(:,:) 2062 2196 END WHERE 2063 2197 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%clcat' ) … … 2087 2221 2088 2222 IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean 2089 ztmp1(:,:) = alb edo_oce_mix(:,:) * zfr_l(:,:)2090 DO jl =1,jpl2223 ztmp1(:,:) = alb_oce_mix(:,:) * zfr_l(:,:) 2224 DO jl = 1, jpl 2091 2225 ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl) 2092 END DO2226 END DO 2093 2227 CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2094 2228 ENDIF … … 2105 2239 IF( ssnd(jps_fice)%laction ) CALL cpl_snd( jps_fice, isec, ztmp3, info ) 2106 2240 ENDIF 2241 2242 IF( ssnd(jps_fice1)%laction ) THEN 2243 SELECT CASE( sn_snd_thick1%clcat ) 2244 CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl) 2245 CASE( 'no' ) ; ztmp3(:,:,1 ) = fr_i(:,: ) 2246 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick1%clcat' ) 2247 END SELECT 2248 CALL cpl_snd( jps_fice1, isec, ztmp3, info ) 2249 ENDIF 2107 2250 2108 2251 ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling) … … 2119 2262 SELECT CASE( sn_snd_thick%clcat ) 2120 2263 CASE( 'yes' ) 2121 ztmp3(:,:,1:jpl) = h t_i(:,:,1:jpl) * a_i(:,:,1:jpl)2122 ztmp4(:,:,1:jpl) = h t_s(:,:,1:jpl) * a_i(:,:,1:jpl)2264 ztmp3(:,:,1:jpl) = h_i(:,:,1:jpl) * a_i(:,:,1:jpl) 2265 ztmp4(:,:,1:jpl) = h_s(:,:,1:jpl) * a_i(:,:,1:jpl) 2123 2266 CASE( 'no' ) 2124 2267 ztmp3(:,:,:) = 0.0 ; ztmp4(:,:,:) = 0.0 2125 2268 DO jl=1,jpl 2126 ztmp3(:,:,1) = ztmp3(:,:,1) + h t_i(:,:,jl) * a_i(:,:,jl)2127 ztmp4(:,:,1) = ztmp4(:,:,1) + h t_s(:,:,jl) * a_i(:,:,jl)2269 ztmp3(:,:,1) = ztmp3(:,:,1) + h_i(:,:,jl) * a_i(:,:,jl) 2270 ztmp4(:,:,1) = ztmp4(:,:,1) + h_s(:,:,jl) * a_i(:,:,jl) 2128 2271 ENDDO 2129 2272 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) … … 2132 2275 SELECT CASE( sn_snd_thick%clcat ) 2133 2276 CASE( 'yes' ) 2134 ztmp3(:,:,1:jpl) = h t_i(:,:,1:jpl)2135 ztmp4(:,:,1:jpl) = h t_s(:,:,1:jpl)2277 ztmp3(:,:,1:jpl) = h_i(:,:,1:jpl) 2278 ztmp4(:,:,1:jpl) = h_s(:,:,1:jpl) 2136 2279 CASE( 'no' ) 2137 2280 WHERE( SUM( a_i, dim=3 ) /= 0. ) 2138 ztmp3(:,:,1) = SUM( h t_i * a_i, dim=3 ) / SUM( a_i, dim=3 )2139 ztmp4(:,:,1) = SUM( h t_s * a_i, dim=3 ) / SUM( a_i, dim=3 )2281 ztmp3(:,:,1) = SUM( h_i * a_i, dim=3 ) / SUM( a_i, dim=3 ) 2282 ztmp4(:,:,1) = SUM( h_s * a_i, dim=3 ) / SUM( a_i, dim=3 ) 2140 2283 ELSEWHERE 2141 2284 ztmp3(:,:,1) = 0. … … 2149 2292 IF( ssnd(jps_hsnw)%laction ) CALL cpl_snd( jps_hsnw, isec, ztmp4, info ) 2150 2293 ENDIF 2294 2295 #if defined key_lim3 2296 ! ! ------------------------- ! 2297 ! ! Ice melt ponds ! 2298 ! ! ------------------------- ! 2299 ! needed by Met Office 2300 IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN 2301 SELECT CASE( sn_snd_mpnd%cldes) 2302 CASE( 'ice only' ) 2303 SELECT CASE( sn_snd_mpnd%clcat ) 2304 CASE( 'yes' ) 2305 ztmp3(:,:,1:jpl) = a_ip(:,:,1:jpl) 2306 ztmp4(:,:,1:jpl) = v_ip(:,:,1:jpl) 2307 CASE( 'no' ) 2308 ztmp3(:,:,:) = 0.0 2309 ztmp4(:,:,:) = 0.0 2310 DO jl=1,jpl 2311 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip(:,:,jpl) 2312 ztmp4(:,:,1) = ztmp4(:,:,1) + v_ip(:,:,jpl) 2313 ENDDO 2314 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' ) 2315 END SELECT 2316 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%cldes' ) 2317 END SELECT 2318 IF( ssnd(jps_a_p)%laction ) CALL cpl_snd( jps_a_p , isec, ztmp3, info ) 2319 IF( ssnd(jps_ht_p)%laction ) CALL cpl_snd( jps_ht_p, isec, ztmp4, info ) 2320 ENDIF 2321 ! 2322 ! ! ------------------------- ! 2323 ! ! Ice conductivity ! 2324 ! ! ------------------------- ! 2325 ! needed by Met Office 2326 IF( ssnd(jps_kice)%laction ) THEN 2327 SELECT CASE( sn_snd_cond%cldes) 2328 CASE( 'weighted ice' ) 2329 SELECT CASE( sn_snd_cond%clcat ) 2330 CASE( 'yes' ) 2331 ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2332 CASE( 'no' ) 2333 ztmp3(:,:,:) = 0.0 2334 DO jl=1,jpl 2335 ztmp3(:,:,1) = ztmp3(:,:,1) + cnd_ice(:,:,jl) * a_i(:,:,jl) 2336 ENDDO 2337 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' ) 2338 END SELECT 2339 CASE( 'ice only' ) 2340 ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl) 2341 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%cldes' ) 2342 END SELECT 2343 IF( ssnd(jps_kice)%laction ) CALL cpl_snd( jps_kice, isec, ztmp3, info ) 2344 ENDIF 2345 #endif 2346 2151 2347 ! ! ------------------------- ! 2152 2348 ! ! CO2 flux from PISCES ! … … 2470 2666 IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 2471 2667 2472 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 2473 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 2668 #if defined key_lim3 2669 ! ! ------------------------- ! 2670 ! ! Sea surface freezing temp ! 2671 ! ! ------------------------- ! 2672 ! needed by Met Office 2673 CALL eos_fzp(tsn(:,:,1,jp_sal), sstfrz) 2674 ztmp1(:,:) = sstfrz(:,:) + rt0 2675 IF( ssnd(jps_sstfrz)%laction ) CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info) 2676 #endif 2474 2677 ! 2475 2678 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_snd')
Note: See TracChangeset
for help on using the changeset viewer.
