- Timestamp:
- 2019-12-05T11:46:38+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbccpl.F90
r11348 r12063 453 453 CASE( 'conservative' ) 454 454 srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. 455 IF 455 IF( k_ice <= 1 ) srcv(jpr_ievp)%laction = .FALSE. 456 456 CASE( 'oce and ice' ) ; srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE. 457 457 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) … … 557 557 srcv(jpr_botm )%clname = 'OBotMlt' 558 558 IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 559 IF 559 IF( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN 560 560 srcv(jpr_topm:jpr_botm)%nct = nn_cats_cpl 561 561 ELSE … … 568 568 ! ! ------------------------- ! 569 569 srcv(jpr_ts_ice)%clname = 'OTsfIce' ! needed by Met Office 570 IF 571 IF 572 IF 570 IF( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' ) srcv(jpr_ts_ice)%laction = .TRUE. 571 IF( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' ) srcv(jpr_ts_ice)%nct = nn_cats_cpl 572 IF( TRIM( sn_rcv_emp%clcat ) == 'yes' ) srcv(jpr_ievp)%nct = nn_cats_cpl 573 573 574 574 ! ! ------------------------- ! … … 692 692 ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere 693 693 DO jn = 1, jprcv 694 IF 694 IF( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) 695 695 END DO 696 696 ! … … 719 719 ! =================================================== ! 720 720 DO jn = 1, jprcv 721 IF 721 IF( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 722 722 END DO 723 723 ! Allocate taum part of frcv which is used even when not received as coupling field 724 IF 724 IF( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 725 725 ! Allocate w10m part of frcv which is used even when not received as coupling field 726 IF 726 IF( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 727 727 ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 728 IF 729 IF 728 IF( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 729 IF( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 730 730 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 731 731 IF( k_ice /= 0 ) THEN 732 IF 733 IF 734 END 732 IF( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 733 IF( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 734 ENDIF 735 735 736 736 ! ================================ ! … … 756 756 CASE( 'oce and ice' , 'weighted oce and ice' , 'oce and weighted ice' ) 757 757 ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 758 IF 758 IF( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = nn_cats_cpl 759 759 CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix )%laction = .TRUE. 760 760 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) … … 776 776 ! 1. sending mixed oce-ice albedo or 777 777 ! 2. receiving mixed oce-ice solar radiation 778 IF 778 IF( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN 779 779 CALL oce_alb( zaos, zacs ) 780 780 ! Due to lack of information on nebulosity : mean clear/overcast sky … … 795 795 ssnd(jps_fice1)%laction = .TRUE. ! First-order regridded ice concentration, to be used producing atmos-to-ice fluxes (Met Office requirement) 796 796 ! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now 797 IF 798 IF 797 IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = nn_cats_cpl 798 IF( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = nn_cats_cpl 799 799 ENDIF 800 800 801 IF 801 IF(TRIM( sn_snd_ifrac%cldes ) == 'coupled') ssnd(jps_ficet)%laction = .TRUE. 802 802 803 803 SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) … … 805 805 CASE( 'ice and snow' ) 806 806 ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 807 IF 807 IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 808 808 ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl 809 809 ENDIF 810 810 CASE ( 'weighted ice and snow' ) 811 811 ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 812 IF 812 IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl 813 813 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' ) 814 814 END SELECT … … 827 827 ssnd(jps_a_p)%laction = .TRUE. 828 828 ssnd(jps_ht_p)%laction = .TRUE. 829 IF 829 IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 830 830 ssnd(jps_a_p)%nct = nn_cats_cpl 831 831 ssnd(jps_ht_p)%nct = nn_cats_cpl 832 832 ELSE 833 IF 833 IF( nn_cats_cpl > 1 ) THEN 834 834 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' ) 835 835 ENDIF … … 838 838 ssnd(jps_a_p)%laction = .TRUE. 839 839 ssnd(jps_ht_p)%laction = .TRUE. 840 IF 840 IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 841 841 ssnd(jps_a_p)%nct = nn_cats_cpl 842 842 ssnd(jps_ht_p)%nct = nn_cats_cpl … … 913 913 CASE ( 'ice only' ) 914 914 ssnd(jps_ttilyr)%laction = .TRUE. 915 IF 915 IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN 916 916 ssnd(jps_ttilyr)%nct = nn_cats_cpl 917 917 ELSE 918 IF 918 IF( nn_cats_cpl > 1 ) THEN 919 919 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_ttilyr%cldes if not exchanging category fields' ) 920 920 ENDIF … … 922 922 CASE ( 'weighted ice' ) 923 923 ssnd(jps_ttilyr)%laction = .TRUE. 924 IF 924 IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl 925 925 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_ttilyr%cldes;'//sn_snd_ttilyr%cldes ) 926 926 END SELECT … … 932 932 CASE ( 'ice only' ) 933 933 ssnd(jps_kice)%laction = .TRUE. 934 IF 934 IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN 935 935 ssnd(jps_kice)%nct = nn_cats_cpl 936 936 ELSE 937 IF 937 IF( nn_cats_cpl > 1 ) THEN 938 938 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' ) 939 939 ENDIF … … 941 941 CASE ( 'weighted ice' ) 942 942 ssnd(jps_kice)%laction = .TRUE. 943 IF 943 IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl 944 944 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes;'//sn_snd_cond%cldes ) 945 945 END SELECT … … 1002 1002 ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere 1003 1003 DO jn = 1, jpsnd 1004 IF 1004 IF( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname)) 1005 1005 END DO 1006 1006 ! … … 1029 1029 CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 1030 1030 1031 IF 1031 IF(ln_usecplmask) THEN 1032 1032 xcplmask(:,:,:) = 0. 1033 1033 CALL iom_open( 'cplmask', inum ) … … 1265 1265 1266 1266 IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) ! correct this later (read from restart if possible) 1267 END 1267 ENDIF 1268 1268 ! 1269 1269 IF( ln_sdw ) THEN ! Stokes Drift correction activated … … 1414 1414 ELSE IF( srcv(jpr_qnsmix)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1415 1415 ELSE ; zqns(:,:) = 0._wp 1416 END 1416 ENDIF 1417 1417 ! update qns over the free ocean with: 1418 1418 IF( nn_components /= jp_iam_opa ) THEN … … 1686 1686 ! --- evaporation over ice (kg/m2/s) --- ! 1687 1687 DO jl=1,jpl 1688 IF 1688 IF(sn_rcv_emp%clcat == 'yes') THEN ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 1689 1689 ELSE ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,1 ) ; ENDIF 1690 1690 ENDDO … … 1785 1785 CASE( 'conservative' ) ! the required fields are directly provided 1786 1786 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1787 IF 1787 IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1788 1788 zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1789 1789 ELSE … … 1794 1794 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1795 1795 zqns_tot(:,:) = ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1796 IF 1796 IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1797 1797 DO jl=1,jpl 1798 1798 zqns_tot(:,: ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl) … … 1896 1896 #endif 1897 1897 ! outputs 1898 IF 1899 IF 1900 IF 1901 IF 1898 IF( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * rLfus ) ! latent heat from calving 1899 IF( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * rLfus ) ! latent heat from icebergs melting 1900 IF( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea' , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) ! heat flux from rain (cell average) 1901 IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) & 1902 1902 & * picefr(:,:) ) * zcptn(:,:) * tmask(:,:,1) ) ! heat flux from evap (cell average) 1903 IF 1904 IF 1903 IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) ) ! heat flux from snow (cell average) 1904 IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 1905 1905 & * ( 1._wp - zsnw(:,:) ) ) ! heat flux from snow (over ocean) 1906 IF 1906 IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 1907 1907 & * zsnw(:,:) ) ! heat flux from snow (over ice) 1908 1908 ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp. … … 1915 1915 CASE( 'conservative' ) 1916 1916 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1917 IF 1917 IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1918 1918 zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 1919 1919 ELSE … … 1927 1927 CASE( 'oce and ice' ) 1928 1928 zqsr_tot(:,: ) = ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 1929 IF 1929 IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1930 1930 DO jl = 1, jpl 1931 1931 zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl) … … 1983 1983 ! ! ========================= ! 1984 1984 CASE ('coupled') 1985 IF 1985 IF( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 1986 1986 zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 1987 1987 ELSE … … 2061 2061 IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 2062 2062 2063 IF 2063 IF( nn_components == jp_iam_opa ) THEN 2064 2064 ztmp1(:,:) = tsn(:,:,1,jp_tem) ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part 2065 2065 ELSE … … 2466 2466 IF( ssnd(jps_ficet)%laction ) THEN 2467 2467 CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info ) 2468 END 2468 ENDIF 2469 2469 ! ! ------------------------- ! 2470 2470 ! ! Water levels to waves ! … … 2481 2481 ENDIF 2482 2482 CALL cpl_snd( jps_wlev , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2483 END 2483 ENDIF 2484 2484 ! 2485 2485 ! Fields sent by OPA to SAS when doing OPA<->SAS coupling
Note: See TracChangeset
for help on using the changeset viewer.
