Changeset 14644 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbccpl.F90
- Timestamp:
- 2021-03-26T15:33:49+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/SBC/sbccpl.F90 (modified) (46 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final
- Property svn:externals
-
old new 9 9 10 10 # SETTE 11 ^/utils/CI/sette _wave@13990sette11 ^/utils/CI/sette@14244 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbccpl.F90
r14219 r14644 129 129 INTEGER, PARAMETER :: jpr_icb = 61 130 130 INTEGER, PARAMETER :: jpr_ts_ice = 62 ! Sea ice surface temp 131 !!INTEGER, PARAMETER :: jpr_qtrice = 63 ! Transmitted solar thru sea-ice 131 132 132 133 INTEGER, PARAMETER :: jprcv = 62 ! total number of fields received … … 157 158 INTEGER, PARAMETER :: jps_rnf = 24 ! runoffs 158 159 INTEGER, PARAMETER :: jps_taum = 25 ! wind stress module 159 INTEGER, PARAMETER :: jps_fice2 = 26 ! ice fraction sent to O PA (by SAS when doing SAS-OPAcoupling)160 INTEGER, PARAMETER :: jps_fice2 = 26 ! ice fraction sent to OCE (by SAS when doing SAS-OCE coupling) 160 161 INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl) 161 162 INTEGER, PARAMETER :: jps_fraqsr = 28 ! fraction of solar net radiation absorbed in the first ocean level … … 202 203 & sn_rcv_wstrf, sn_rcv_wdrag, sn_rcv_charn, sn_rcv_taw, sn_rcv_bhd, sn_rcv_tusd, sn_rcv_tvsd 203 204 ! ! Other namelist parameters 205 !! TYPE(FLD_C) :: sn_rcv_qtrice 204 206 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 205 207 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models … … 238 240 !! *** FUNCTION sbc_cpl_alloc *** 239 241 !!---------------------------------------------------------------------- 240 INTEGER :: ierr( 5)242 INTEGER :: ierr(4) 241 243 !!---------------------------------------------------------------------- 242 244 ierr(:) = 0 … … 248 250 #endif 249 251 ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 250 #if defined key_si3 || defined key_cice 251 ALLOCATE( a_i_last_couple(jpi,jpj,jpl) , STAT=ierr(4) ) 252 #endif 253 ! 254 IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(5) ) 252 ! 253 IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(4) ) 255 254 256 255 sbc_cpl_alloc = MAXVAL( ierr ) … … 287 286 & sn_rcv_charn , sn_rcv_taw , sn_rcv_bhd , sn_rcv_tusd , sn_rcv_tvsd, & 288 287 & sn_rcv_wdrag , sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , & 289 & sn_rcv_iceflx, sn_rcv_co2 , sn_rcv_icb , sn_rcv_isf , sn_rcv_ts_ice 288 & sn_rcv_iceflx, sn_rcv_co2 , sn_rcv_icb , sn_rcv_isf , sn_rcv_ts_ice !!, sn_rcv_qtrice 290 289 291 290 !!--------------------------------------------------------------------- … … 328 327 WRITE(numout,*)' ice shelf = ', TRIM(sn_rcv_isf%cldes ), ' (', TRIM(sn_rcv_isf%clcat ), ')' 329 328 WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 329 !! WRITE(numout,*)' transmitted solar thru sea-ice = ', TRIM(sn_rcv_qtrice%cldes), ' (', TRIM(sn_rcv_qtrice%clcat), ')' 330 330 WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')' 331 331 WRITE(numout,*)' Sea ice surface skin temperature= ', TRIM(sn_rcv_ts_ice%cldes), ' (', TRIM(sn_rcv_ts_ice%clcat), ')' … … 603 603 srcv(jpr_mslp)%clname = 'O_MSLP' ; IF( TRIM(sn_rcv_mslp%cldes ) == 'coupled' ) srcv(jpr_mslp)%laction = .TRUE. 604 604 ! 605 ! ! ------------------------- !606 ! ! ice topmelt and botmelt !607 ! ! ------------------------- !605 ! ! --------------------------------- ! 606 ! ! ice topmelt and conduction flux ! 607 ! ! --------------------------------- ! 608 608 srcv(jpr_topm )%clname = 'OTopMlt' 609 609 srcv(jpr_botm )%clname = 'OBotMlt' … … 616 616 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 617 617 ENDIF 618 !! ! ! --------------------------- ! 619 !! ! ! transmitted solar thru ice ! 620 !! ! ! --------------------------- ! 621 !! srcv(jpr_qtrice)%clname = 'OQtr' 622 !! IF( TRIM(sn_rcv_qtrice%cldes) == 'coupled' ) THEN 623 !! IF ( TRIM( sn_rcv_qtrice%clcat ) == 'yes' ) THEN 624 !! srcv(jpr_qtrice)%nct = nn_cats_cpl 625 !! ELSE 626 !! CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qtrice%clcat should always be set to yes currently' ) 627 !! ENDIF 628 !! srcv(jpr_qtrice)%laction = .TRUE. 629 !! ENDIF 618 630 ! ! ------------------------- ! 619 631 ! ! ice skin temperature ! … … 707 719 ! 708 720 ! ! ------------------------------- ! 709 ! ! O PA-SAS coupling - rcv by opa !721 ! ! OCE-SAS coupling - rcv by opa ! 710 722 ! ! ------------------------------- ! 711 723 srcv(jpr_sflx)%clname = 'O_SFLX' 712 724 srcv(jpr_fice)%clname = 'RIceFrc' 713 725 ! 714 IF( nn_components == jp_iam_o pa ) THEN ! OPA coupled to SAS via OASIS: force received field by OPA(sent by SAS)726 IF( nn_components == jp_iam_oce ) THEN ! OCE coupled to SAS via OASIS: force received field by OCE (sent by SAS) 715 727 srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 716 728 srcv(:)%clgrid = 'T' ! force default definition in case of opa <-> sas coupling … … 728 740 IF(lwp) THEN ! control print 729 741 WRITE(numout,*) 730 WRITE(numout,*)' Special conditions for SAS-O PAcoupling '731 WRITE(numout,*)' O PAcomponent '742 WRITE(numout,*)' Special conditions for SAS-OCE coupling ' 743 WRITE(numout,*)' OCE component ' 732 744 WRITE(numout,*) 733 745 WRITE(numout,*)' received fields from SAS component ' … … 743 755 ENDIF 744 756 ! ! -------------------------------- ! 745 ! ! O PA-SAS coupling - rcv by sas !757 ! ! OCE-SAS coupling - rcv by sas ! 746 758 ! ! -------------------------------- ! 747 759 srcv(jpr_toce )%clname = 'I_SSTSST' … … 763 775 ! Vectors: change of sign at north fold ONLY if on the local grid 764 776 srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1. 765 ! Change first letter to couple with atmosphere if already coupled O PA777 ! Change first letter to couple with atmosphere if already coupled OCE 766 778 ! this is nedeed as each variable name used in the namcouple must be unique: 767 ! for example O_Runoff received by O PAfrom SAS and therefore S_Runoff received by SAS from the Atmosphere779 ! for example O_Runoff received by OCE from SAS and therefore S_Runoff received by SAS from the Atmosphere 768 780 DO jn = 1, jprcv 769 781 IF( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) … … 772 784 IF(lwp) THEN ! control print 773 785 WRITE(numout,*) 774 WRITE(numout,*)' Special conditions for SAS-O PAcoupling '786 WRITE(numout,*)' Special conditions for SAS-OCE coupling ' 775 787 WRITE(numout,*)' SAS component ' 776 788 WRITE(numout,*) 777 789 IF( .NOT. ln_cpl ) THEN 778 WRITE(numout,*)' received fields from O PAcomponent '790 WRITE(numout,*)' received fields from OCE component ' 779 791 ELSE 780 WRITE(numout,*)' Additional received fields from O PAcomponent : '792 WRITE(numout,*)' Additional received fields from OCE component : ' 781 793 ENDIF 782 794 WRITE(numout,*)' sea surface temperature (Celsius) ' … … 889 901 END SELECT 890 902 891 ! Initialise ice fractions from last coupling time to zero (needed by Met-Office)892 #if defined key_si3 || defined key_cice893 a_i_last_couple(:,:,:) = 0._wp894 #endif895 903 ! ! ------------------------- ! 896 904 ! ! Ice Meltponds ! … … 1029 1037 1030 1038 ! ! ------------------------------- ! 1031 ! ! O PA-SAS coupling - snd by opa !1039 ! ! OCE-SAS coupling - snd by opa ! 1032 1040 ! ! ------------------------------- ! 1033 1041 ssnd(jps_ssh )%clname = 'O_SSHght' … … 1036 1044 ssnd(jps_fraqsr)%clname = 'O_FraQsr' 1037 1045 ! 1038 IF( nn_components == jp_iam_o pa) THEN1046 IF( nn_components == jp_iam_oce ) THEN 1039 1047 ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 1040 1048 ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE. … … 1060 1068 ENDIF 1061 1069 ! ! ------------------------------- ! 1062 ! ! O PA-SAS coupling - snd by sas !1070 ! ! OCE-SAS coupling - snd by sas ! 1063 1071 ! ! ------------------------------- ! 1064 1072 ssnd(jps_sflx )%clname = 'I_SFLX' … … 1078 1086 ! Change first letter to couple with atmosphere if already coupled with sea_ice 1079 1087 ! this is nedeed as each variable name used in the namcouple must be unique: 1080 ! for example O_SSTSST sent by O PAto SAS and therefore S_SSTSST sent by SAS to the Atmosphere1088 ! for example O_SSTSST sent by OCE to SAS and therefore S_SSTSST sent by SAS to the Atmosphere 1081 1089 DO jn = 1, jpsnd 1082 1090 IF( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname)) … … 1086 1094 WRITE(numout,*) 1087 1095 IF( .NOT. ln_cpl ) THEN 1088 WRITE(numout,*)' sent fields to O PAcomponent '1096 WRITE(numout,*)' sent fields to OCE component ' 1089 1097 ELSE 1090 WRITE(numout,*)' Additional sent fields to O PAcomponent : '1098 WRITE(numout,*)' Additional sent fields to OCE component : ' 1091 1099 ENDIF 1092 1100 WRITE(numout,*)' ice cover ' … … 1249 1257 frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) 1250 1258 END_2D 1251 CALL lbc_lnk _multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U', -1.0_wp, frcv(jpr_oty1)%z3(:,:,1), 'V', -1.0_wp )1259 CALL lbc_lnk( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U', -1.0_wp, frcv(jpr_oty1)%z3(:,:,1), 'V', -1.0_wp ) 1252 1260 ENDIF 1253 1261 llnewtx = .TRUE. … … 1526 1534 ENDIF 1527 1535 ! update qns over the free ocean with: 1528 IF( nn_components /= jp_iam_o pa) THEN1536 IF( nn_components /= jp_iam_oce ) THEN 1529 1537 zqns(:,:) = zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST) 1530 1538 IF( srcv(jpr_snow )%laction ) THEN … … 1590 1598 !! ** Action : return ptau_i, ptau_j, the stress over the ice 1591 1599 !!---------------------------------------------------------------------- 1592 REAL(wp), INTENT( out), DIMENSION(:,:) :: p_taui ! i- & j-components of atmos-ice stress [N/m2]1593 REAL(wp), INTENT( out), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid)1600 REAL(wp), INTENT(inout), DIMENSION(:,:) :: p_taui ! i- & j-components of atmos-ice stress [N/m2] 1601 REAL(wp), INTENT(inout), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid) 1594 1602 !! 1595 1603 INTEGER :: ji, jj ! dummy loop indices … … 1598 1606 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty 1599 1607 !!---------------------------------------------------------------------- 1608 ! 1609 #if defined key_si3 || defined key_cice 1600 1610 ! 1601 1611 IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1 … … 1667 1677 p_tauj(ji,jj) = zztmp2 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 1668 1678 END_2D 1679 <<<<<<< .working 1669 1680 CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U', -1._wp, p_tauj, 'V', -1._wp ) 1681 ||||||| .merge-left.r14199 1682 CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U', -1., p_tauj, 'V', -1. ) 1683 ======= 1684 CALL lbc_lnk( 'sbccpl', p_taui, 'U', -1., p_tauj, 'V', -1. ) 1685 >>>>>>> .merge-right.r14642 1670 1686 END SELECT 1671 1687 1672 1688 ENDIF 1673 1689 ! 1690 #endif 1691 ! 1674 1692 END SUBROUTINE sbc_cpl_ice_tau 1675 1693 1676 1694 1677 SUBROUTINE sbc_cpl_ice_flx( picefr, palbi, psst, pist, phs, phi )1695 SUBROUTINE sbc_cpl_ice_flx( kt, picefr, palbi, psst, pist, phs, phi ) 1678 1696 !!---------------------------------------------------------------------- 1679 1697 !! *** ROUTINE sbc_cpl_ice_flx *** … … 1717 1735 !! are provided but not included in emp here. Only runoff will 1718 1736 !! be included in emp in other parts of NEMO code 1737 !! 1738 !! ** Note : In case of the ice-atm coupling with conduction fluxes (such as Jules interface for the Met-Office), 1739 !! qsr_ice and qns_ice are not provided and they are not supposed to be used in the ice code. 1740 !! However, by precaution we also "fake" qns_ice and qsr_ice this way: 1741 !! qns_ice = qml_ice + qcn_ice ?? 1742 !! qsr_ice = qtr_ice_top ?? 1743 !! 1719 1744 !! ** Action : update at each nf_ice time step: 1720 1745 !! qns_tot, qsr_tot non-solar and solar total heat fluxes … … 1725 1750 !! sprecip solid precipitation over the ocean 1726 1751 !!---------------------------------------------------------------------- 1752 INTEGER, INTENT(in) :: kt ! ocean model time step index (only for a_i_last_couple) 1727 1753 REAL(wp), INTENT(in) , DIMENSION(:,:) :: picefr ! ice fraction [0 to 1] 1728 1754 ! !! ! optional arguments, used only in 'mixed oce-ice' case or for Met-Office coupling … … 1741 1767 REAL(wp), DIMENSION(jpi,jpj) :: ztri 1742 1768 !!---------------------------------------------------------------------- 1769 ! 1770 #if defined key_si3 || defined key_cice 1771 ! 1772 IF( kt == nit000 ) THEN 1773 ! allocate ice fractions from last coupling time here and not in sbc_cpl_init because of jpl 1774 IF( .NOT.ALLOCATED(a_i_last_couple) ) ALLOCATE( a_i_last_couple(jpi,jpj,jpl) ) 1775 ! initialize to a_i for the 1st time step 1776 a_i_last_couple(:,:,:) = a_i(:,:,:) 1777 ENDIF 1743 1778 ! 1744 1779 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1768 1803 CALL ctl_stop('STOP', 'sbccpl/sbc_cpl_ice_flx: some fields are not defined. Change sn_rcv_emp value in namelist namsbc_cpl') 1769 1804 END SELECT 1770 1771 #if defined key_si31772 1805 1773 1806 ! --- evaporation over ice (kg/m2/s) --- ! … … 1861 1894 ENDIF 1862 1895 1863 #else 1864 zsnw(:,:) = picefr(:,:) 1865 ! --- Continental fluxes --- ! 1866 IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on) 1867 rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1868 ENDIF 1869 IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot) 1870 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1871 ENDIF 1872 IF( srcv(jpr_icb)%laction ) THEN ! iceberg added to runoffs 1873 fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1) 1874 rnf(:,:) = rnf(:,:) + fwficb(:,:) 1875 ENDIF 1876 IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting) 1877 fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1) 1878 ENDIF 1879 ! 1880 IF( ln_mixcpl ) THEN 1881 emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 1882 emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 1883 sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1884 tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1885 ELSE 1886 emp_tot(:,:) = zemp_tot(:,:) 1887 emp_ice(:,:) = zemp_ice(:,:) 1888 sprecip(:,:) = zsprecip(:,:) 1889 tprecip(:,:) = ztprecip(:,:) 1890 ENDIF 1891 ! 1892 #endif 1893 1896 !! for CICE ?? 1897 !!$ zsnw(:,:) = picefr(:,:) 1898 !!$ ! --- Continental fluxes --- ! 1899 !!$ IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on) 1900 !!$ rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1901 !!$ ENDIF 1902 !!$ IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot) 1903 !!$ zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1904 !!$ ENDIF 1905 !!$ IF( srcv(jpr_icb)%laction ) THEN ! iceberg added to runoffs 1906 !!$ fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1) 1907 !!$ rnf(:,:) = rnf(:,:) + fwficb(:,:) 1908 !!$ ENDIF 1909 !!$ IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting) 1910 !!$ fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1) 1911 !!$ ENDIF 1912 !!$ ! 1913 !!$ IF( ln_mixcpl ) THEN 1914 !!$ emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 1915 !!$ emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 1916 !!$ sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1917 !!$ tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1918 !!$ ELSE 1919 !!$ emp_tot(:,:) = zemp_tot(:,:) 1920 !!$ emp_ice(:,:) = zemp_ice(:,:) 1921 !!$ sprecip(:,:) = zsprecip(:,:) 1922 !!$ tprecip(:,:) = ztprecip(:,:) 1923 !!$ ENDIF 1924 ! 1894 1925 ! outputs 1895 !! IF( srcv(jpr_rnf)%laction ) CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1) ) ! runoff1896 !! IF( srcv(jpr_isf)%laction ) CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) * tmask(:,:,1) ) ! iceshelf1897 1926 IF( srcv(jpr_cal)%laction ) CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1) ) ! calving 1898 1927 IF( srcv(jpr_icb)%laction ) CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1) ) ! icebergs … … 1907 1936 & - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1908 1937 ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf 1938 !! IF( srcv(jpr_rnf)%laction ) CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1) ) ! runoff 1939 !! IF( srcv(jpr_isf)%laction ) CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) * tmask(:,:,1) ) ! iceshelf 1940 ! 1941 ! ! ========================= ! 1942 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! ice topmelt and botmelt ! 1943 ! ! ========================= ! 1944 CASE ('coupled') 1945 IF (ln_scale_ice_flux) THEN 1946 WHERE( a_i(:,:,:) > 1.e-10_wp ) 1947 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 1948 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 1949 ELSEWHERE 1950 qml_ice(:,:,:) = 0.0_wp 1951 qcn_ice(:,:,:) = 0.0_wp 1952 END WHERE 1953 ELSE 1954 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 1955 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 1956 ENDIF 1957 END SELECT 1909 1958 ! 1910 1959 ! ! ========================= ! … … 1912 1961 ! ! ========================= ! 1913 1962 CASE( 'oce only' ) ! the required field is directly provided 1914 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 1915 ! For Met Office sea ice non-solar fluxes are already delt with by JULES so setting to zero 1916 ! here so the only flux is the ocean only one. 1917 zqns_ice(:,:,:) = 0._wp 1963 ! Get the sea ice non solar heat flux from conductive, melting and sublimation fluxes 1964 IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 1965 zqns_ice(:,:,:) = qml_ice(:,:,:) + qcn_ice(:,:,:) 1966 ELSE 1967 zqns_ice(:,:,:) = 0._wp 1968 ENDIF 1969 ! Calculate the total non solar heat flux. The ocean only non solar heat flux (zqns_oce) will be recalculated after this CASE 1970 ! statement to be consistent with other coupling methods even though .zqns_oce = frcv(jpr_qnsoce)%z3(:,:,1) 1971 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) + SUM( zqns_ice(:,:,:) * a_i(:,:,:), dim=3 ) 1918 1972 CASE( 'conservative' ) ! the required fields are directly provided 1919 1973 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) … … 1962 2016 IF( srcv(jpr_icb)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus ! remove latent heat of iceberg melting 1963 2017 1964 #if defined key_si31965 2018 ! --- non solar flux over ocean --- ! 1966 2019 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax … … 2015 2068 ENDIF 2016 2069 2017 #else 2018 zcptsnw (:,:) = zcptn(:,:) 2019 zcptrain(:,:) = zcptn(:,:)2020 2021 ! clem: this formulation is certainly wrong... but better than it was... 2022 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 2023 & - ( ziceld(:,:) * zsprecip(:,:) * rLfus ) & ! remove the latent heat flux of solid precip. melting 2024 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 2025 & - zemp_ice(:,:) ) * zcptn(:,:)2026 2027 IF( ln_mixcpl ) THEN 2028 qns_tot(:,:) = qns(:,:) * ziceld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 2029 qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 2030 DO jl=1,jpl 2031 qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 2032 ENDDO 2033 ELSE 2034 qns_tot(:,: ) = zqns_tot(:,: ) 2035 qns_ice(:,:,:) = zqns_ice(:,:,:)2036 ENDIF 2037 2038 #endif 2070 !! for CICE ?? 2071 !!$ ! --- non solar flux over ocean --- ! 2072 !!$ zcptsnw (:,:) = zcptn(:,:) 2073 !!$ zcptrain(:,:) = zcptn(:,:) 2074 !!$ 2075 !!$ ! clem: this formulation is certainly wrong... but better than it was... 2076 !!$ zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 2077 !!$ & - ( ziceld(:,:) * zsprecip(:,:) * rLfus ) & ! remove the latent heat flux of solid precip. melting 2078 !!$ & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 2079 !!$ & - zemp_ice(:,:) ) * zcptn(:,:) 2080 !!$ 2081 !!$ IF( ln_mixcpl ) THEN 2082 !!$ qns_tot(:,:) = qns(:,:) * ziceld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 2083 !!$ qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 2084 !!$ DO jl=1,jpl 2085 !!$ qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 2086 !!$ ENDDO 2087 !!$ ELSE 2088 !!$ qns_tot(:,: ) = zqns_tot(:,: ) 2089 !!$ qns_ice(:,:,:) = zqns_ice(:,:,:) 2090 !!$ ENDIF 2091 2039 2092 ! outputs 2040 2093 IF ( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * rLfus ) ! latent heat from calving … … 2057 2110 ! 2058 2111 ! ! ========================= ! 2112 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) ! d(qns)/dt ! 2113 ! ! ========================= ! 2114 CASE ('coupled') 2115 IF( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 2116 zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 2117 ELSE 2118 ! Set all category values equal for the moment 2119 DO jl=1,jpl 2120 zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 2121 ENDDO 2122 ENDIF 2123 CASE( 'none' ) 2124 zdqns_ice(:,:,:) = 0._wp 2125 END SELECT 2126 2127 IF( ln_mixcpl ) THEN 2128 DO jl=1,jpl 2129 dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:) 2130 ENDDO 2131 ELSE 2132 dqns_ice(:,:,:) = zdqns_ice(:,:,:) 2133 ENDIF 2134 ! ! ========================= ! 2059 2135 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) ! solar heat fluxes ! (qsr) 2060 2136 ! ! ========================= ! 2061 2137 CASE( 'oce only' ) 2062 2138 zqsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 2063 ! For Met Office sea ice solar fluxes are already delt with by JULES so setting to zero2064 ! here so the only flux is the ocean only one.2139 ! For the Met Office the only sea ice solar flux is the transmitted qsr which is added onto zqsr_ice 2140 ! further down. Therefore start zqsr_ice off at zero. 2065 2141 zqsr_ice(:,:,:) = 0._wp 2066 2142 CASE( 'conservative' ) … … 2115 2191 END DO 2116 2192 ENDIF 2117 2118 #if defined key_si32119 ! --- solar flux over ocean --- !2120 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax2121 zqsr_oce = 0._wp2122 WHERE( ziceld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:)2123 2124 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:)2125 ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF2126 #endif2127 2128 IF( ln_mixcpl ) THEN2129 qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk2130 qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:)* zmsk(:,:)2131 DO jl = 1, jpl2132 qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) + zqsr_ice(:,:,jl)* zmsk(:,:)2133 END DO2134 ELSE2135 qsr_tot(:,: ) = zqsr_tot(:,: )2136 qsr_ice(:,:,:) = zqsr_ice(:,:,:)2137 ENDIF2138 2139 ! ! ========================= !2140 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) ! d(qns)/dt !2141 ! ! ========================= !2142 CASE ('coupled')2143 IF( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN2144 zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)2145 ELSE2146 ! Set all category values equal for the moment2147 DO jl=1,jpl2148 zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)2149 ENDDO2150 ENDIF2151 CASE( 'none' )2152 zdqns_ice(:,:,:) = 0._wp2153 END SELECT2154 2155 IF( ln_mixcpl ) THEN2156 DO jl=1,jpl2157 dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:)2158 ENDDO2159 ELSE2160 dqns_ice(:,:,:) = zdqns_ice(:,:,:)2161 ENDIF2162 2163 #if defined key_si32164 ! ! ========================= !2165 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! ice topmelt and botmelt !2166 ! ! ========================= !2167 CASE ('coupled')2168 IF (ln_scale_ice_flux) THEN2169 WHERE( a_i(:,:,:) > 1.e-10_wp )2170 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)2171 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)2172 ELSEWHERE2173 qml_ice(:,:,:) = 0.0_wp2174 qcn_ice(:,:,:) = 0.0_wp2175 END WHERE2176 ELSE2177 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:)2178 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:)2179 ENDIF2180 END SELECT2181 2193 ! ! ========================= ! 2182 2194 ! ! Transmitted Qsr ! [W/m2] … … 2210 2222 ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN !== conduction flux as surface forcing ==! 2211 2223 ! 2212 ! ! ===> here we must receive the qtr_ice_top array from the coupler 2213 ! for now just assume zero (fully opaque ice) 2224 !! SELECT CASE( TRIM( sn_rcv_qtrice%cldes ) ) 2225 !! ! 2226 !! ! ! ===> here we receive the qtr_ice_top array from the coupler 2227 !! CASE ('coupled') 2228 !! IF (ln_scale_ice_flux) THEN 2229 !! WHERE( a_i(:,:,:) > 1.e-10_wp ) 2230 !! zqtr_ice_top(:,:,:) = frcv(jpr_qtrice)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 2231 !! ELSEWHERE 2232 !! zqtr_ice_top(:,:,:) = 0.0_wp 2233 !! ENDWHERE 2234 !! ELSE 2235 !! zqtr_ice_top(:,:,:) = frcv(jpr_qtrice)%z3(:,:,:) 2236 !! ENDIF 2237 !! 2238 !! ! Add retrieved transmitted solar radiation onto the ice and total solar radiation 2239 !! zqsr_ice(:,:,:) = zqsr_ice(:,:,:) + zqtr_ice_top(:,:,:) 2240 !! zqsr_tot(:,:) = zqsr_tot(:,:) + SUM( zqtr_ice_top(:,:,:) * a_i(:,:,:), dim=3 ) 2241 !! 2242 !! ! if we are not getting this data from the coupler then assume zero (fully opaque ice) 2243 !! CASE ('none') 2214 2244 zqtr_ice_top(:,:,:) = 0._wp 2215 ! 2216 ENDIF 2217 ! 2245 !! END SELECT 2246 ! 2247 ENDIF 2248 2218 2249 IF( ln_mixcpl ) THEN 2219 DO jl=1,jpl 2250 qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 2251 qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:) * zmsk(:,:) 2252 DO jl = 1, jpl 2253 qsr_ice (:,:,jl) = qsr_ice (:,:,jl) * xcplmask(:,:,0) + zqsr_ice (:,:,jl) * zmsk(:,:) 2220 2254 qtr_ice_top(:,:,jl) = qtr_ice_top(:,:,jl) * xcplmask(:,:,0) + zqtr_ice_top(:,:,jl) * zmsk(:,:) 2221 END DO2255 END DO 2222 2256 ELSE 2257 qsr_tot (:,: ) = zqsr_tot (:,: ) 2258 qsr_ice (:,:,:) = zqsr_ice (:,:,:) 2223 2259 qtr_ice_top(:,:,:) = zqtr_ice_top(:,:,:) 2224 2260 ENDIF 2261 2262 ! --- solar flux over ocean --- ! 2263 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax 2264 zqsr_oce = 0._wp 2265 WHERE( ziceld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:) 2266 2267 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:) 2268 ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF 2269 2225 2270 ! ! ================== ! 2226 2271 ! ! ice skin temp. ! … … 2276 2321 IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 2277 2322 2278 IF( nn_components == jp_iam_o pa) THEN2323 IF( nn_components == jp_iam_oce ) THEN 2279 2324 ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part 2280 2325 ELSE 2281 ! we must send the surface potential temperature 2326 ! we must send the surface potential temperature 2282 2327 IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( CASTWP(ts(:,:,1,jp_tem,Kmm)),CASTWP(ts(:,:,1,jp_sal,Kmm)) ) 2283 2328 ELSE ; ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) … … 2428 2473 ENDIF 2429 2474 2430 ! Send ice fraction field to O PA (sent by SAS in SAS-OPAcoupling)2475 ! Send ice fraction field to OCE (sent by SAS in SAS-OCE coupling) 2431 2476 IF( ssnd(jps_fice2)%laction ) THEN 2432 2477 ztmp3(:,:,1) = fr_i(:,:) … … 2544 2589 ! i-1 i i 2545 2590 ! i i+1 (for I) 2546 IF( nn_components == jp_iam_o pa) THEN2591 IF( nn_components == jp_iam_oce ) THEN 2547 2592 zotx1(:,:) = uu(:,:,1,Kmm) 2548 2593 zoty1(:,:) = vv(:,:,1,Kmm) … … 2561 2606 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2562 2607 END_2D 2563 CALL lbc_lnk _multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp )2608 CALL lbc_lnk( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) 2564 2609 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2565 2610 DO_2D( 0, 0, 0, 0 ) … … 2570 2615 END_2D 2571 2616 END SELECT 2572 CALL lbc_lnk _multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocy1)%clgrid, -1.0_wp )2617 CALL lbc_lnk( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocy1)%clgrid, -1.0_wp ) 2573 2618 ! 2574 2619 ENDIF … … 2638 2683 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2639 2684 END_2D 2640 CALL lbc_lnk _multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp )2685 CALL lbc_lnk( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) 2641 2686 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2642 2687 DO_2D( 0, 0, 0, 0 ) … … 2647 2692 END_2D 2648 2693 END SELECT 2649 CALL lbc_lnk _multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp )2694 CALL lbc_lnk( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp ) 2650 2695 ! 2651 2696 ! … … 2701 2746 ENDIF 2702 2747 ! 2703 ! Fields sent by O PA to SAS when doing OPA<->SAS coupling2748 ! Fields sent by OCE to SAS when doing OCE<->SAS coupling 2704 2749 ! ! SSH 2705 2750 IF( ssnd(jps_ssh )%laction ) THEN … … 2725 2770 ENDIF 2726 2771 ! 2727 ! Fields sent by SAS to O PAwhen OASIS coupling2772 ! Fields sent by SAS to OCE when OASIS coupling 2728 2773 ! ! Solar heat flux 2729 2774 IF( ssnd(jps_qsroce)%laction ) CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info )
Note: See TracChangeset
for help on using the changeset viewer.
