Changeset 6578 for branches/UKMO/dev_r5518_GC3_couple_pkg
- Timestamp:
- 2016-05-19T15:24:34+02:00 (8 years ago)
- Location:
- branches/UKMO/dev_r5518_GC3_couple_pkg/NEMOGCM/NEMO/OPA_SRC/SBC
- Files:
-
- 2 edited
-
geo2ocean.F90 (modified) (2 diffs)
-
sbccpl.F90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GC3_couple_pkg/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
r6574 r6578 51 51 52 52 SUBROUTINE repcmo ( pxu1, pyu1, pxv1, pyv1, & 53 px2 , py2 )53 px2 , py2 , kchoix ) 54 54 !!---------------------------------------------------------------------- 55 55 !! *** ROUTINE repcmo *** … … 68 68 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: py2 ! j-componante (defined at v-point) 69 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 ) 75 70 INTEGER, INTENT( IN ) :: & 71 kchoix ! type of transformation 72 ! = 1 change from geographic to model grid. 73 ! =-1 change from model to geographic grid 74 !!---------------------------------------------------------------------- 75 76 SELECT CASE (kchoix) 77 CASE ( 1) 78 ! Change from geographic to stretched coordinate 79 ! ---------------------------------------------- 80 81 CALL rot_rep( pxu1, pyu1, 'U', 'en->i',px2 ) 82 CALL rot_rep( pxv1, pyv1, 'V', 'en->j',py2 ) 83 CASE (-1) 84 ! Change from stretched to geographic coordinate 85 ! ---------------------------------------------- 86 87 CALL rot_rep( pxu1, pyu1, 'U', 'ij->e',px2 ) 88 CALL rot_rep( pxv1, pyv1, 'V', 'ij->n',py2 ) 89 END SELECT 90 76 91 END SUBROUTINE repcmo 77 92 -
branches/UKMO/dev_r5518_GC3_couple_pkg/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6577 r6578 340 340 srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point 341 341 srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point 342 srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 342 !srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 343 ! Currently needed for HadGEM3 - but shouldn't affect anyone else for the moment 344 srcv(jpr_otx1)%laction = .TRUE. 345 srcv(jpr_oty1)%laction = .TRUE. 346 ! 343 347 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only 344 348 CASE( 'T,I' ) … … 848 852 INTEGER :: ji, jj, jn ! dummy loop indices 849 853 INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000) 854 INTEGER :: ikchoix 850 855 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 851 856 REAL(wp) :: zcoef ! temporary scalar … … 853 858 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 854 859 REAL(wp) :: zzx, zzy ! temporary variables 855 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr 860 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 856 861 !!---------------------------------------------------------------------- 857 862 ! 858 863 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') 859 864 ! 860 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )865 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) 861 866 ! 862 867 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 896 901 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 897 902 ! ! (geographical to local grid -> rotate the components) 898 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 899 IF( srcv(jpr_otx2)%laction ) THEN 900 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 901 ELSE 902 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 903 IF( srcv(jpr_otx1)%clgrid == 'U' .AND. (.NOT. srcv(jpr_otx2)%laction) ) THEN 904 ! Temporary code for HadGEM3 - will be removed eventually. 905 ! Only applies when we have only taux on U grid and tauy on V grid 906 DO jj=2,jpjm1 907 DO ji=2,jpim1 908 ztx(ji,jj)=0.25*vmask(ji,jj,1) & 909 *(frcv(jpr_otx1)%z3(ji,jj,1)+frcv(jpr_otx1)%z3(ji-1,jj,1) & 910 +frcv(jpr_otx1)%z3(ji,jj+1,1)+frcv(jpr_otx1)%z3(ji-1,jj+1,1)) 911 zty(ji,jj)=0.25*umask(ji,jj,1) & 912 *(frcv(jpr_oty1)%z3(ji,jj,1)+frcv(jpr_oty1)%z3(ji+1,jj,1) & 913 +frcv(jpr_oty1)%z3(ji,jj-1,1)+frcv(jpr_oty1)%z3(ji+1,jj-1,1)) 914 ENDDO 915 ENDDO 916 917 ikchoix = 1 918 CALL repcmo (frcv(jpr_otx1)%z3(:,:,1),zty,ztx,frcv(jpr_oty1)%z3(:,:,1),ztx2,zty2,ikchoix) 919 CALL lbc_lnk (ztx2,'U', -1. ) 920 CALL lbc_lnk (zty2,'V', -1. ) 921 frcv(jpr_otx1)%z3(:,:,1)=ztx2(:,:) 922 frcv(jpr_oty1)%z3(:,:,1)=zty2(:,:) 923 ELSE 924 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 925 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 926 IF( srcv(jpr_otx2)%laction ) THEN 927 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 928 ELSE 929 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 930 ENDIF 931 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid 903 932 ENDIF 904 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid905 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid906 933 ENDIF 907 934 ! … … 1114 1141 ENDIF 1115 1142 ! 1116 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )1143 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) 1117 1144 ! 1118 1145 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv') … … 1709 1736 ! 1710 1737 INTEGER :: ji, jj, jl ! dummy loop indices 1738 INTEGER :: ikchoix 1711 1739 INTEGER :: isec, info ! local integer 1712 1740 REAL(wp) :: zumax, zvmax … … 1861 1889 ! j+1 j -----V---F 1862 1890 ! surface velocity always sent from T point ! | 1863 ! 1891 ! [except for HadGEM3] j | T U 1864 1892 ! | | 1865 1893 ! j j-1 -I-------| … … 1873 1901 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 1874 1902 CASE( 'oce only' ) ! C-grid ==> T 1875 DO jj = 2, jpjm1 1876 DO ji = fs_2, fs_jpim1 ! vector opt. 1877 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 1878 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 1903 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 1904 DO jj = 2, jpjm1 1905 DO ji = fs_2, fs_jpim1 ! vector opt. 1906 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 1907 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 1908 END DO 1879 1909 END DO 1880 END DO 1910 ELSE 1911 ! Temporarily Changed for UKV 1912 DO jj = 2, jpjm1 1913 DO ji = 2, jpim1 1914 zotx1(ji,jj) = un(ji,jj,1) 1915 zoty1(ji,jj) = vn(ji,jj,1) 1916 END DO 1917 END DO 1918 ENDIF 1881 1919 CASE( 'weighted oce and ice' ) 1882 1920 SELECT CASE ( cp_ice_msh ) … … 1937 1975 END DO 1938 1976 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 1939 DO jj = 2, jpjm1 1940 DO ji = 2, jpim1 ! NO vector opt. 1941 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 1942 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1943 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1944 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 1945 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1946 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1977 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 1978 DO jj = 2, jpjm1 1979 DO ji = 2, jpim1 ! NO vector opt. 1980 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj,1) ) * zfr_l(ji,jj) & 1981 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1982 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1983 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji,jj-1,1) ) * zfr_l(ji,jj) & 1984 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1985 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1986 END DO 1947 1987 END DO 1948 END DO 1988 #if defined key_cice 1989 ELSE 1990 ! Temporarily Changed for HadGEM3 1991 DO jj = 2, jpjm1 1992 DO ji = 2, jpim1 ! NO vector opt. 1993 zotx1(ji,jj) = (1.0-fr_iu(ji,jj)) * un(ji,jj,1) & 1994 & + fr_iu(ji,jj) * 0.5 * ( u_ice(ji,jj-1) + u_ice(ji,jj) ) 1995 zoty1(ji,jj) = (1.0-fr_iv(ji,jj)) * vn(ji,jj,1) & 1996 & + fr_iv(ji,jj) * 0.5 * ( v_ice(ji-1,jj) + v_ice(ji,jj) ) 1997 END DO 1998 END DO 1999 #endif 2000 ENDIF 1949 2001 END SELECT 1950 2002 END SELECT … … 1956 2008 IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components 1957 2009 ! ! Ocean component 1958 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 1959 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 1960 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 1961 zoty1(:,:) = ztmp2(:,:) 1962 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 1963 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 1964 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 1965 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 1966 zity1(:,:) = ztmp2(:,:) 1967 ENDIF 2010 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 2011 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2012 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2013 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 2014 zoty1(:,:) = ztmp2(:,:) 2015 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 2016 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2017 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2018 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 2019 zity1(:,:) = ztmp2(:,:) 2020 ENDIF 2021 ELSE 2022 ! Temporary code for HadGEM3 - will be removed eventually. 2023 ! Only applies when we want uvel on U grid and vvel on V grid 2024 ! Rotate U and V onto geographic grid before sending. 2025 2026 DO jj=2,jpjm1 2027 DO ji=2,jpim1 2028 ztmp1(ji,jj)=0.25*vmask(ji,jj,1) & 2029 *(zotx1(ji,jj)+zotx1(ji-1,jj) & 2030 +zotx1(ji,jj+1)+zotx1(ji-1,jj+1)) 2031 ztmp2(ji,jj)=0.25*umask(ji,jj,1) & 2032 *(zoty1(ji,jj)+zoty1(ji+1,jj) & 2033 +zoty1(ji,jj-1)+zoty1(ji+1,jj-1)) 2034 ENDDO 2035 ENDDO 2036 2037 ! Ensure any N fold and wrap columns are updated 2038 CALL lbc_lnk(ztmp1, 'V', -1.0) 2039 CALL lbc_lnk(ztmp2, 'U', -1.0) 2040 2041 ikchoix = -1 2042 CALL repcmo (zotx1,ztmp2,ztmp1,zoty1,zotx1,zoty1,ikchoix) 2043 ENDIF 1968 2044 ENDIF 1969 2045 !
Note: See TracChangeset
for help on using the changeset viewer.
