Changeset 7139
- Timestamp:
- 2016-10-27T15:21:12+02:00 (7 years ago)
- Location:
- branches/UKMO/r5936_hadgem3_cplfld/NEMOGCM/NEMO/OPA_SRC/SBC
- Files:
-
- 2 edited
-
geo2ocean.F90 (modified) (2 diffs)
-
sbccpl.F90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/r5936_hadgem3_cplfld/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
r7138 r7139 51 51 52 52 SUBROUTINE repcmo ( pxu1, pyu1, pxv1, pyv1, & 53 px2 , py2 )53 px2 , py2, kchoix ) 54 54 !!---------------------------------------------------------------------- 55 55 !! *** ROUTINE repcmo *** … … 67 67 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: px2 ! i-componante (defined at u-point) 68 68 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: py2 ! j-componante (defined at v-point) 69 !!---------------------------------------------------------------------- 70 71 ! Change from geographic to stretched coordinate 72 ! ---------------------------------------------- 73 CALL rot_rep( pxu1, pyu1, 'U', 'en->i',px2 ) 74 CALL rot_rep( pxv1, pyv1, 'V', 'en->j',py2 ) 69 INTEGER, INTENT( IN ) :: kchoix ! type of transformation 70 ! = 1 change from geographic to model grid. 71 ! =-1 change from model to geographic grid 72 !!---------------------------------------------------------------------- 73 74 SELECT CASE (kchoix) 75 CASE ( 1) 76 ! Change from geographic to stretched coordinate 77 ! ---------------------------------------------- 78 79 CALL rot_rep( pxu1, pyu1, 'U', 'en->i',px2 ) 80 CALL rot_rep( pxv1, pyv1, 'V', 'en->j',py2 ) 81 CASE (-1) 82 ! Change from stretched to geographic coordinate 83 ! ---------------------------------------------- 84 85 CALL rot_rep( pxu1, pyu1, 'U', 'ij->e',px2 ) 86 CALL rot_rep( pxv1, pyv1, 'V', 'ij->n',py2 ) 87 END SELECT 75 88 76 89 END SUBROUTINE repcmo -
branches/UKMO/r5936_hadgem3_cplfld/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r7138 r7139 337 337 srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point 338 338 srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point 339 srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 339 !srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 340 ! Currently needed for HadGEM3 - but shouldn't affect anyone else for the moment 341 srcv(jpr_otx1)%laction = .TRUE. 342 srcv(jpr_oty1)%laction = .TRUE. 343 ! 340 344 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only 341 345 CASE( 'T,I' ) … … 845 849 INTEGER :: ji, jj, jn ! dummy loop indices 846 850 INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000) 851 INTEGER :: ikchoix 847 852 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 848 853 REAL(wp) :: zcoef ! temporary scalar … … 850 855 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 851 856 REAL(wp) :: zzx, zzy ! temporary variables 852 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, z msk, zemp, zqns, zqsr857 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, ztx2, zty2, zmsk, zemp, zqns, zqsr 853 858 !!---------------------------------------------------------------------- 854 859 ! 855 860 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') 856 861 ! 857 CALL wrk_alloc( jpi,jpj, ztx, zty, z msk, zemp, zqns, zqsr )862 CALL wrk_alloc( jpi,jpj, ztx, zty, ztx2, zty2, zmsk, zemp, zqns, zqsr ) 858 863 ! 859 864 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 893 898 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 894 899 ! ! (geographical to local grid -> rotate the components) 895 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 896 IF( srcv(jpr_otx2)%laction ) THEN 897 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 898 ELSE 899 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 900 IF( srcv(jpr_otx1)%clgrid == 'U' .AND. (.NOT. srcv(jpr_otx2)%laction) ) THEN 901 ! Temporary code for HadGEM3 - will be removed eventually. 902 ! Only applies when we have only taux on U grid and tauy on V grid 903 DO jj=2,jpjm1 904 DO ji=2,jpim1 905 ztx(ji,jj)=0.25*vmask(ji,jj,1) & 906 *(frcv(jpr_otx1)%z3(ji,jj,1)+frcv(jpr_otx1)%z3(ji-1,jj,1) & 907 +frcv(jpr_otx1)%z3(ji,jj+1,1)+frcv(jpr_otx1)%z3(ji-1,jj+1,1)) 908 zty(ji,jj)=0.25*umask(ji,jj,1) & 909 *(frcv(jpr_oty1)%z3(ji,jj,1)+frcv(jpr_oty1)%z3(ji+1,jj,1) & 910 +frcv(jpr_oty1)%z3(ji,jj-1,1)+frcv(jpr_oty1)%z3(ji+1,jj-1,1)) 911 ENDDO 912 ENDDO 913 914 ikchoix = 1 915 CALL repcmo(frcv(jpr_otx1)%z3(:,:,1),zty,ztx,frcv(jpr_oty1)%z3(:,:,1),ztx2,zty2,ikchoix) 916 CALL lbc_lnk (ztx2,'U', -1. ) 917 CALL lbc_lnk (zty2,'V', -1. ) 918 frcv(jpr_otx1)%z3(:,:,1)=ztx2(:,:) 919 frcv(jpr_oty1)%z3(:,:,1)=zty2(:,:) 920 ELSE 921 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 922 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 923 IF( srcv(jpr_otx2)%laction ) THEN 924 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 925 ELSE 926 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 927 ENDIF 928 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid 900 929 ENDIF 901 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid902 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid903 930 ENDIF 904 931 ! … … 1107 1134 ENDIF 1108 1135 ! 1109 CALL wrk_dealloc( jpi,jpj, ztx, zty, z msk, zemp, zqns, zqsr )1136 CALL wrk_dealloc( jpi,jpj, ztx, zty, ztx2, zty2, zmsk, zemp, zqns, zqsr ) 1110 1137 ! 1111 1138 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv') … … 1702 1729 ! 1703 1730 INTEGER :: ji, jj, jl ! dummy loop indices 1731 INTEGER :: ikchoix 1704 1732 INTEGER :: isec, info ! local integer 1705 1733 REAL(wp) :: zumax, zvmax … … 1730 1758 ! 1731 1759 SELECT CASE( sn_snd_temp%cldes) 1760 CASE( 'none' ) ! nothing to do 1732 1761 CASE( 'oce only' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0 1733 1762 CASE( 'oce and ice' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0 … … 1854 1883 ! j+1 j -----V---F 1855 1884 ! surface velocity always sent from T point ! | 1856 ! 1885 ! [except for HadGEM3] j | T U 1857 1886 ! | | 1858 1887 ! j j-1 -I-------| … … 1866 1895 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 1867 1896 CASE( 'oce only' ) ! C-grid ==> T 1868 DO jj = 2, jpjm1 1869 DO ji = fs_2, fs_jpim1 ! vector opt. 1870 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 1871 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 1872 END DO 1873 END DO 1897 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 1898 DO jj = 2, jpjm1 1899 DO ji = fs_2, fs_jpim1 ! vector opt. 1900 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 1901 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji,jj-1,1) ) 1902 END DO 1903 END DO 1904 ELSE 1905 ! Temporarily Changed for UKV 1906 DO jj = 2, jpjm1 1907 DO ji = 2, jpim1 1908 zotx1(ji,jj) = un(ji,jj,1) 1909 zoty1(ji,jj) = vn(ji,jj,1) 1910 END DO 1911 END DO 1912 ENDIF 1874 1913 CASE( 'weighted oce and ice' ) 1875 1914 SELECT CASE ( cp_ice_msh ) … … 1895 1934 END DO 1896 1935 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 1897 DO jj = 2, jpjm1 1898 DO ji = 2, jpim1 ! NO vector opt. 1899 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) 1900 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) 1901 zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1902 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1903 zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1904 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1905 END DO 1906 END DO 1936 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 1937 DO jj = 2, jpjm1 1938 DO ji = 2, jpim1 ! NO vector opt. 1939 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj,1) ) * zfr_l(ji,jj) & 1940 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1941 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1942 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji,jj-1,1) ) * zfr_l(ji,jj) & 1943 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1944 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1945 END DO 1946 END DO 1947 #if defined key_cice 1948 ELSE 1949 ! Temporarily Changed for HadGEM3 1950 DO jj = 2, jpjm1 1951 DO ji = 2, jpim1 ! NO vector opt. 1952 zotx1(ji,jj) = (1.0-fr_iu(ji,jj)) * un(ji,jj,1) & 1953 & + fr_iu(ji,jj) * 0.5 * ( u_ice(ji,jj-1) + u_ice(ji,jj) ) 1954 zoty1(ji,jj) = (1.0-fr_iv(ji,jj)) * vn(ji,jj,1) & 1955 & + fr_iv(ji,jj) * 0.5 * ( v_ice(ji-1,jj) + v_ice(ji,jj) ) 1956 END DO 1957 END DO 1958 #endif 1959 ENDIF 1907 1960 END SELECT 1908 1961 CALL lbc_lnk( zitx1, 'T', -1. ) ; CALL lbc_lnk( zity1, 'T', -1. ) … … 1949 2002 IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components 1950 2003 ! ! Ocean component 1951 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 1952 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 1953 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 1954 zoty1(:,:) = ztmp2(:,:) 1955 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 1956 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 1957 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 1958 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 1959 zity1(:,:) = ztmp2(:,:) 1960 ENDIF 2004 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 2005 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2006 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2007 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 2008 zoty1(:,:) = ztmp2(:,:) 2009 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 2010 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2011 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2012 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 2013 zity1(:,:) = ztmp2(:,:) 2014 ENDIF 2015 ELSE 2016 ! Temporary code for HadGEM3 - will be removed eventually. 2017 ! Only applies when we want uvel on U grid and vvel on V grid 2018 ! Rotate U and V onto geographic grid before sending. 2019 2020 DO jj=2,jpjm1 2021 DO ji=2,jpim1 2022 ztmp1(ji,jj)=0.25*vmask(ji,jj,1) & 2023 *(zotx1(ji,jj)+zotx1(ji-1,jj) & 2024 +zotx1(ji,jj+1)+zotx1(ji-1,jj+1)) 2025 ztmp2(ji,jj)=0.25*umask(ji,jj,1) & 2026 *(zoty1(ji,jj)+zoty1(ji+1,jj) & 2027 +zoty1(ji,jj-1)+zoty1(ji+1,jj-1)) 2028 ENDDO 2029 ENDDO 2030 2031 ! Ensure any N fold and wrap columns are updated 2032 CALL lbc_lnk(ztmp1, 'V', -1.0) 2033 CALL lbc_lnk(ztmp2, 'U', -1.0) 2034 2035 ikchoix = -1 2036 CALL repcmo(zotx1,ztmp2,ztmp1,zoty1,zotx1,zoty1,ikchoix) 2037 ENDIF 1961 2038 ENDIF 1962 2039 !
Note: See TracChangeset
for help on using the changeset viewer.
