Changeset 10395
- Timestamp:
- 2018-12-14T15:58:02+01:00 (4 years ago)
- Location:
- branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/SBC
- Files:
-
- 2 edited
-
geo2ocean.F90 (modified) (2 diffs)
-
sbccpl.F90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
r8058 r10395 51 51 52 52 SUBROUTINE repcmo ( pxu1, pyu1, pxv1, pyv1, & 53 px2 , py2 )53 px2 , py2, kchoix ) 54 54 !!---------------------------------------------------------------------- 55 55 !! *** ROUTINE repcmo *** … … 69 69 !!---------------------------------------------------------------------- 70 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 ) 71 INTEGER, INTENT( IN ) :: 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 75 90 76 91 END SUBROUTINE repcmo -
branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r10394 r10395 342 342 srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point 343 343 srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point 344 srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 344 !srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 345 ! Currently needed for HadGEM3 - but shouldn't affect anyone else for the moment 346 srcv(jpr_otx1)%laction = .TRUE. 347 srcv(jpr_oty1)%laction = .TRUE. 348 ! 345 349 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only 346 350 CASE( 'T,I' ) … … 850 854 INTEGER :: ji, jj, jn ! dummy loop indices 851 855 INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000) 856 INTEGER :: ikchoix 852 857 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 853 858 REAL(wp) :: zcoef ! temporary scalar … … 855 860 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 856 861 REAL(wp) :: zzx, zzy ! temporary variables 857 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, z msk, zemp, zqns, zqsr862 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, ztx2, zty2, zmsk, zemp, zqns, zqsr 858 863 !!---------------------------------------------------------------------- 859 864 ! 860 865 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') 861 866 ! 862 CALL wrk_alloc( jpi,jpj, ztx, zty, z msk, zemp, zqns, zqsr )867 CALL wrk_alloc( jpi,jpj, ztx, zty, ztx2, zty2, zmsk, zemp, zqns, zqsr ) 863 868 ! 864 869 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 898 903 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 899 904 ! ! (geographical to local grid -> rotate the components) 900 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 901 IF( srcv(jpr_otx2)%laction ) THEN 902 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 903 ELSE 904 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 905 IF( srcv(jpr_otx1)%clgrid == 'U' .AND. (.NOT. srcv(jpr_otx2)%laction) ) THEN 906 ! Temporary code for HadGEM3 - will be removed eventually. 907 ! Only applies when we have only taux on U grid and tauy on V grid 908 DO jj=2,jpjm1 909 DO ji=2,jpim1 910 ztx(ji,jj)=0.25*vmask(ji,jj,1) & 911 *(frcv(jpr_otx1)%z3(ji,jj,1)+frcv(jpr_otx1)%z3(ji-1,jj,1) & 912 +frcv(jpr_otx1)%z3(ji,jj+1,1)+frcv(jpr_otx1)%z3(ji-1,jj+1,1)) 913 zty(ji,jj)=0.25*umask(ji,jj,1) & 914 *(frcv(jpr_oty1)%z3(ji,jj,1)+frcv(jpr_oty1)%z3(ji+1,jj,1) & 915 +frcv(jpr_oty1)%z3(ji,jj-1,1)+frcv(jpr_oty1)%z3(ji+1,jj-1,1)) 916 ENDDO 917 ENDDO 918 919 ikchoix = 1 920 CALL repcmo(frcv(jpr_otx1)%z3(:,:,1),zty,ztx,frcv(jpr_oty1)%z3(:,:,1),ztx2,zty2,ikchoix) 921 CALL lbc_lnk (ztx2,'U', -1. ) 922 CALL lbc_lnk (zty2,'V', -1. ) 923 frcv(jpr_otx1)%z3(:,:,1)=ztx2(:,:) 924 frcv(jpr_oty1)%z3(:,:,1)=zty2(:,:) 925 ELSE 926 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 927 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 928 IF( srcv(jpr_otx2)%laction ) THEN 929 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 930 ELSE 931 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 932 ENDIF 933 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid 905 934 ENDIF 906 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid907 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid908 935 ENDIF 909 936 ! … … 1118 1145 ENDIF 1119 1146 ! 1120 CALL wrk_dealloc( jpi,jpj, ztx, zty, z msk, zemp, zqns, zqsr )1147 CALL wrk_dealloc( jpi,jpj, ztx, zty, ztx2, zty2, zmsk, zemp, zqns, zqsr ) 1121 1148 ! 1122 1149 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv') … … 1713 1740 ! 1714 1741 INTEGER :: ji, jj, jl ! dummy loop indices 1742 INTEGER :: ikchoix 1715 1743 INTEGER :: isec, info ! local integer 1716 1744 REAL(wp) :: zumax, zvmax … … 1770 1798 ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 1771 1799 ENDDO 1800 CASE( 'none' ) ! nothing to do 1772 1801 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1773 1802 END SELECT … … 1894 1923 ! j+1 j -----V---F 1895 1924 ! surface velocity always sent from T point ! | 1896 ! 1925 ! [except for HadGEM3] j | T U 1897 1926 ! | | 1898 1927 ! j j-1 -I-------| … … 1906 1935 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 1907 1936 CASE( 'oce only' ) ! C-grid ==> T 1908 DO jj = 2, jpjm1 1909 DO ji = fs_2, fs_jpim1 ! vector opt. 1910 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 1911 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 1912 END DO 1913 END DO 1937 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 1938 DO jj = 2, jpjm1 1939 DO ji = fs_2, fs_jpim1 ! vector opt. 1940 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 1941 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji,jj-1,1) ) 1942 END DO 1943 END DO 1944 ELSE 1945 ! Temporarily Changed for UKV 1946 DO jj = 2, jpjm1 1947 DO ji = 2, jpim1 1948 zotx1(ji,jj) = un(ji,jj,1) 1949 zoty1(ji,jj) = vn(ji,jj,1) 1950 END DO 1951 END DO 1952 ENDIF 1914 1953 CASE( 'weighted oce and ice' ) 1915 1954 SELECT CASE ( cp_ice_msh ) … … 1935 1974 END DO 1936 1975 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 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 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) 1941 zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1942 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1943 zity1(ji,jj) = 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 1976 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 1977 DO jj = 2, jpjm1 1978 DO ji = 2, jpim1 ! NO vector opt. 1979 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj,1) ) * zfr_l(ji,jj) & 1980 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1981 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1982 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji,jj-1,1) ) * zfr_l(ji,jj) & 1983 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1984 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1985 END DO 1986 END DO 1987 #if defined key_cice 1988 ELSE 1989 ! Temporarily Changed for HadGEM3 1990 DO jj = 2, jpjm1 1991 DO ji = 2, jpim1 ! NO vector opt. 1992 zotx1(ji,jj) = (1.0-fr_iu(ji,jj)) * un(ji,jj,1) & 1993 & + fr_iu(ji,jj) * 0.5 * ( u_ice(ji,jj-1) + u_ice(ji,jj) ) 1994 zoty1(ji,jj) = (1.0-fr_iv(ji,jj)) * vn(ji,jj,1) & 1995 & + fr_iv(ji,jj) * 0.5 * ( v_ice(ji-1,jj) + v_ice(ji,jj) ) 1996 END DO 1997 END DO 1998 #endif 1999 ENDIF 1947 2000 END SELECT 1948 2001 CALL lbc_lnk( zitx1, 'T', -1. ) ; CALL lbc_lnk( zity1, 'T', -1. ) … … 1989 2042 IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components 1990 2043 ! ! Ocean component 1991 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 1992 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 1993 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 1994 zoty1(:,:) = ztmp2(:,:) 1995 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 1996 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 1997 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 1998 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 1999 zity1(:,:) = ztmp2(:,:) 2000 ENDIF 2044 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 2045 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2046 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2047 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 2048 zoty1(:,:) = ztmp2(:,:) 2049 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 2050 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2051 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2052 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 2053 zity1(:,:) = ztmp2(:,:) 2054 ENDIF 2055 ELSE 2056 ! Temporary code for HadGEM3 - will be removed eventually. 2057 ! Only applies when we want uvel on U grid and vvel on V grid 2058 ! Rotate U and V onto geographic grid before sending. 2059 2060 DO jj=2,jpjm1 2061 DO ji=2,jpim1 2062 ztmp1(ji,jj)=0.25*vmask(ji,jj,1) & 2063 *(zotx1(ji,jj)+zotx1(ji-1,jj) & 2064 +zotx1(ji,jj+1)+zotx1(ji-1,jj+1)) 2065 ztmp2(ji,jj)=0.25*umask(ji,jj,1) & 2066 *(zoty1(ji,jj)+zoty1(ji+1,jj) & 2067 +zoty1(ji,jj-1)+zoty1(ji+1,jj-1)) 2068 ENDDO 2069 ENDDO 2070 2071 ! Ensure any N fold and wrap columns are updated 2072 CALL lbc_lnk(ztmp1, 'V', -1.0) 2073 CALL lbc_lnk(ztmp2, 'U', -1.0) 2074 2075 ikchoix = -1 2076 CALL repcmo(zotx1,ztmp2,ztmp1,zoty1,zotx1,zoty1,ikchoix) 2077 ENDIF 2001 2078 ENDIF 2002 2079 !
Note: See TracChangeset
for help on using the changeset viewer.
