Changeset 6152 for trunk/NEMOGCM/NEMO/OPA_SRC/DOM
- Timestamp:
- 2015-12-21T23:33:57+01:00 (8 years ago)
- Location:
- trunk/NEMOGCM/NEMO/OPA_SRC/DOM
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r6140 r6152 23 23 USE dom_oce ! ocean space and time domain 24 24 USE sbc_oce ! ocean surface boundary condition 25 USE wet_dry ! wetting and drying 25 26 USE restart ! ocean restart 26 27 ! … … 687 688 ! ! = 'U', 'V', 'W, 'F', 'UW' or 'VW' 688 689 ! 689 INTEGER :: ji, jj, jk ! dummy loop indices 690 INTEGER :: ji, jj, jk ! dummy loop indices 691 REAL(wp) :: zlnwd ! =1./0. when ln_wd = T/F 690 692 !!---------------------------------------------------------------------- 691 693 ! 692 694 IF( nn_timing == 1 ) CALL timing_start('dom_vvl_interpol') 695 ! 696 IF(ln_wd) THEN 697 zlnwd = 1.0_wp 698 ELSE 699 zlnwd = 0.0_wp 700 END IF 693 701 ! 694 702 SELECT CASE ( pout ) !== type of interpolation ==! … … 698 706 DO jj = 1, jpjm1 699 707 DO ji = 1, fs_jpim1 ! vector opt. 700 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * r1_e1e2u(ji,jj)&708 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj) & 701 709 & * ( e1e2t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 702 710 & + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) … … 711 719 DO jj = 1, jpjm1 712 720 DO ji = 1, fs_jpim1 ! vector opt. 713 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) * r1_e1e2v(ji,jj)&721 pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj) & 714 722 & * ( e1e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 715 723 & + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) … … 724 732 DO jj = 1, jpjm1 725 733 DO ji = 1, fs_jpim1 ! vector opt. 726 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) * r1_e1e2f(ji,jj) & 734 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 735 & * r1_e1e2f(ji,jj) & 727 736 & * ( e1e2u(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3u_0(ji,jj ,jk) ) & 728 737 & + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) … … 739 748 !!gm BUG? use here wmask in case of ISF ? to be checked 740 749 DO jk = 2, jpk 741 pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * tmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) ) & 742 & + 0.5_wp * tmask(:,:,jk) * ( pe3_in(:,:,jk ) - e3t_0(:,:,jk ) ) 750 pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) ) & 751 & * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) ) & 752 & + 0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) & 753 & * ( pe3_in(:,:,jk ) - e3t_0(:,:,jk ) ) 743 754 END DO 744 755 ! … … 749 760 !!gm BUG? use here wumask in case of ISF ? to be checked 750 761 DO jk = 2, jpk 751 pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * umask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) ) & 752 & + 0.5_wp * umask(:,:,jk) * ( pe3_in(:,:,jk ) - e3u_0(:,:,jk ) ) 762 pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) ) & 763 & * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) ) & 764 & + 0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) & 765 & * ( pe3_in(:,:,jk ) - e3u_0(:,:,jk ) ) 753 766 END DO 754 767 ! … … 759 772 !!gm BUG? use here wvmask in case of ISF ? to be checked 760 773 DO jk = 2, jpk 761 pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * vmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) ) & 762 & + 0.5_wp * vmask(:,:,jk) * ( pe3_in(:,:,jk ) - e3v_0(:,:,jk ) ) 774 pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) ) & 775 & * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) ) & 776 & + 0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) & 777 & * ( pe3_in(:,:,jk ) - e3v_0(:,:,jk ) ) 763 778 END DO 764 779 END SELECT … … 784 799 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 785 800 ! 786 INTEGER :: j k801 INTEGER :: ji, jj, jk 787 802 INTEGER :: id1, id2, id3, id4, id5 ! local integers 788 803 !!---------------------------------------------------------------------- … … 872 887 e3t_n(:,:,:) = e3t_0(:,:,:) 873 888 sshn(:,:) = 0.0_wp 889 890 IF( ln_wd ) THEN 891 DO jj = 1, jpj 892 DO ji = 1, jpi 893 IF( e3t_0(ji,jj,1) <= 0.5_wp * rn_wdmin1 ) THEN 894 e3t_b(ji,jj,:) = 0.5_wp * rn_wdmin1 895 e3t_n(ji,jj,:) = 0.5_wp * rn_wdmin1 896 e3t_a(ji,jj,:) = 0.5_wp * rn_wdmin1 897 sshb(ji,jj) = rn_wdmin1 - bathy(ji,jj) 898 sshn(ji,jj) = rn_wdmin1 - bathy(ji,jj) 899 ssha(ji,jj) = rn_wdmin1 - bathy(ji,jj) 900 ENDIF 901 ENDDO 902 ENDDO 903 END IF 904 874 905 IF( ln_vvl_ztilde .OR. ln_vvl_layer) THEN 875 906 tilde_e3t_b(:,:,:) = 0.0_wp -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r6140 r6152 18 18 !! 3.4 ! 2012-12 (R. Bourdalle-Badie and G. Reffray) modify C1D case 19 19 !! 3.6 ! 2014-11 (P. Mathiot and C. Harris) add ice shelf capabilitye 20 !! 3.? ! 2015-11 (H. Liu) Modifications for Wetting/Drying 20 21 !!---------------------------------------------------------------------- 21 22 … … 36 37 USE oce ! ocean variables 37 38 USE dom_oce ! ocean domain 39 USE wet_dry ! wetting and drying 38 40 USE closea ! closed seas 39 41 USE c1d ! 1D vertical configuration … … 1940 1942 bathy(:,:) = MIN( rn_sbot_max, bathy(:,:) ) 1941 1943 1942 DO jj = 1, jpj 1943 DO ji = 1, jpi 1944 IF( bathy(ji,jj) > 0._wp ) bathy(ji,jj) = MAX( rn_sbot_min, bathy(ji,jj) ) 1945 END DO 1946 END DO 1944 IF( .NOT.ln_wd ) THEN 1945 DO jj = 1, jpj 1946 DO ji = 1, jpi 1947 IF( bathy(ji,jj) > 0._wp ) bathy(ji,jj) = MAX( rn_sbot_min, bathy(ji,jj) ) 1948 END DO 1949 END DO 1950 END IF 1947 1951 ! ! ============================= 1948 1952 ! ! Define the envelop bathymetry (hbatt) … … 1951 1955 zenv(:,:) = bathy(:,:) 1952 1956 ! 1957 IF( .NOT.ln_wd ) THEN 1953 1958 ! set first land point adjacent to a wet cell to sbot_min as this needs to be included in smoothing 1954 DO jj = 1, jpj1955 DO ji = 1, jpi1956 IF( bathy(ji,jj) == 0._wp ) THEN1957 iip1 = MIN( ji+1, jpi )1958 ijp1 = MIN( jj+1, jpj )1959 iim1 = MAX( ji-1, 1 )1960 ijm1 = MAX( jj-1, 1 )1959 DO jj = 1, jpj 1960 DO ji = 1, jpi 1961 IF( bathy(ji,jj) == 0._wp ) THEN 1962 iip1 = MIN( ji+1, jpi ) 1963 ijp1 = MIN( jj+1, jpj ) 1964 iim1 = MAX( ji-1, 1 ) 1965 ijm1 = MAX( jj-1, 1 ) 1961 1966 !!gm BUG fix see ticket #1617 1962 IF( ( + bathy(iim1,ijm1) + bathy(ji,ijp1) + bathy(iip1,ijp1) & 1963 & + bathy(iim1,jj ) + bathy(iip1,jj ) & 1964 & + bathy(iim1,ijm1) + bathy(ji,ijm1) + bathy(iip1,ijp1) ) > 0._wp ) zenv(ji,jj) = rn_sbot_min 1967 IF( ( + bathy(iim1,ijm1) + bathy(ji,ijp1) + bathy(iip1,ijp1) & 1968 & + bathy(iim1,jj ) + bathy(iip1,jj ) & 1969 & + bathy(iim1,ijm1) + bathy(ji,ijm1) + bathy(iip1,ijp1) ) > 0._wp ) & 1970 & zenv(ji,jj) = rn_sbot_min 1965 1971 !!gm 1966 1972 !!gm IF( ( bathy(iip1,jj ) + bathy(iim1,jj ) + bathy(ji,ijp1 ) + bathy(ji,ijm1) + & … … 1969 1975 !!gm ENDIF 1970 1976 !!gm end 1971 ENDIF 1972 END DO 1973 END DO 1977 ENDIF 1978 END DO 1979 END DO 1980 END IF 1981 1974 1982 ! apply lateral boundary condition CAUTION: keep the value when the lbc field is zero 1975 1983 CALL lbc_lnk( zenv, 'T', 1._wp, 'no0' ) … … 2064 2072 IF(lwp) THEN 2065 2073 WRITE(numout,*) 2066 WRITE(numout,*) ' zgr_sco: minimum depth of the envelop topography set to : ', rn_sbot_min 2074 IF( .NOT.ln_wd ) THEN 2075 WRITE(numout,*) ' zgr_sco: minimum depth of the envelop topography set to : ', rn_sbot_min 2076 ELSE 2077 WRITE(numout,*) ' zgr_sco: minimum positive depth of the envelop topography set to : ', rn_sbot_min 2078 WRITE(numout,*) ' zgr_sco: minimum negative depth of the envelop topography set to : ', -rn_wdld 2079 ENDIF 2067 2080 ENDIF 2068 2081 hbatu(:,:) = rn_sbot_min … … 2077 2090 END DO 2078 2091 END DO 2092 2093 IF( ln_wd ) THEN !avoid the zero depth on T- (U-,V-,F-) points 2094 DO jj = 1, jpj 2095 DO ji = 1, jpi 2096 IF(ABS(hbatt(ji,jj)) < rn_wdmin1) & 2097 & hbatt(ji,jj) = SIGN(1._wp, hbatt(ji,jj)) * rn_wdmin1 2098 IF(ABS(hbatu(ji,jj)) < rn_wdmin1) & 2099 & hbatu(ji,jj) = SIGN(1._wp, hbatu(ji,jj)) * rn_wdmin1 2100 IF(ABS(hbatv(ji,jj)) < rn_wdmin1) & 2101 & hbatv(ji,jj) = SIGN(1._wp, hbatv(ji,jj)) * rn_wdmin1 2102 IF(ABS(hbatf(ji,jj)) < rn_wdmin1) & 2103 & hbatf(ji,jj) = SIGN(1._wp, hbatf(ji,jj)) * rn_wdmin1 2104 END DO 2105 END DO 2106 END IF 2079 2107 ! 2080 2108 ! Apply lateral boundary condition … … 2084 2112 DO ji = 1, jpi 2085 2113 IF( hbatu(ji,jj) == 0._wp ) THEN 2114 !No worries about the following line when ln_wd == .true. 2086 2115 IF( zhbat(ji,jj) == 0._wp ) hbatu(ji,jj) = rn_sbot_min 2087 2116 IF( zhbat(ji,jj) /= 0._wp ) hbatu(ji,jj) = zhbat(ji,jj) … … 2109 2138 2110 2139 !!bug: key_helsinki a verifer 2111 hift(:,:) = MIN( hift(:,:), hbatt(:,:) ) 2112 hifu(:,:) = MIN( hifu(:,:), hbatu(:,:) ) 2113 hifv(:,:) = MIN( hifv(:,:), hbatv(:,:) ) 2114 hiff(:,:) = MIN( hiff(:,:), hbatf(:,:) ) 2140 IF( .NOT.ln_wd ) THEN 2141 hift(:,:) = MIN( hift(:,:), hbatt(:,:) ) 2142 hifu(:,:) = MIN( hifu(:,:), hbatu(:,:) ) 2143 hifv(:,:) = MIN( hifv(:,:), hbatv(:,:) ) 2144 hiff(:,:) = MIN( hiff(:,:), hbatf(:,:) ) 2145 END IF 2115 2146 2116 2147 IF( nprint == 1 .AND. lwp ) THEN … … 2154 2185 CALL lbc_lnk( e3vw_0, 'V', 1._wp ) 2155 2186 ! 2156 WHERE( e3t_0 (:,:,:) == 0._wp ) e3t_0 (:,:,:) = 1._wp 2157 WHERE( e3u_0 (:,:,:) == 0._wp ) e3u_0 (:,:,:) = 1._wp 2158 WHERE( e3v_0 (:,:,:) == 0._wp ) e3v_0 (:,:,:) = 1._wp 2159 WHERE( e3f_0 (:,:,:) == 0._wp ) e3f_0 (:,:,:) = 1._wp 2160 WHERE( e3w_0 (:,:,:) == 0._wp ) e3w_0 (:,:,:) = 1._wp 2161 WHERE( e3uw_0(:,:,:) == 0._wp ) e3uw_0(:,:,:) = 1._wp 2162 WHERE( e3vw_0(:,:,:) == 0._wp ) e3vw_0(:,:,:) = 1._wp 2187 IF( .NOT.ln_wd ) THEN 2188 WHERE( e3t_0 (:,:,:) == 0._wp ) e3t_0 (:,:,:) = 1._wp 2189 WHERE( e3u_0 (:,:,:) == 0._wp ) e3u_0 (:,:,:) = 1._wp 2190 WHERE( e3v_0 (:,:,:) == 0._wp ) e3v_0 (:,:,:) = 1._wp 2191 WHERE( e3f_0 (:,:,:) == 0._wp ) e3f_0 (:,:,:) = 1._wp 2192 WHERE( e3w_0 (:,:,:) == 0._wp ) e3w_0 (:,:,:) = 1._wp 2193 WHERE( e3uw_0(:,:,:) == 0._wp ) e3uw_0(:,:,:) = 1._wp 2194 WHERE( e3vw_0(:,:,:) == 0._wp ) e3vw_0(:,:,:) = 1._wp 2195 END IF 2163 2196 2164 2197 #if defined key_agrif … … 2193 2226 IF( scobot(ji,jj) >= gdept_n(ji,jj,jk) ) mbathy(ji,jj) = MAX( 2, jk ) 2194 2227 END DO 2195 IF( scobot(ji,jj) == 0._wp ) mbathy(ji,jj) = 0 2228 IF( ln_wd ) THEN 2229 IF( scobot(ji,jj) <= -(rn_wdld - rn_wdmin2)) THEN 2230 mbathy(ji,jj) = 0 2231 ELSEIF(scobot(ji,jj) <= rn_wdmin1) THEN 2232 mbathy(ji,jj) = 2 2233 ENDIF 2234 ELSE 2235 IF( scobot(ji,jj) == 0._wp ) mbathy(ji,jj) = 0 2236 ENDIF 2196 2237 END DO 2197 2238 END DO … … 2311 2352 INTEGER :: ji, jj, jk ! dummy loop argument 2312 2353 REAL(wp) :: zcoeft, zcoefw ! temporary scalars 2354 REAL(wp) :: ztmpu, ztmpv, ztmpf 2355 REAL(wp) :: ztmpu1, ztmpv1, ztmpf1 2313 2356 ! 2314 2357 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3 … … 2365 2408 DO ji = 1, jpim1 2366 2409 DO jj = 1, jpjm1 2410 ! extended for Wetting/Drying case 2411 ztmpu = hbatt(ji,jj)+hbatt(ji+1,jj) 2412 ztmpv = hbatt(ji,jj)+hbatt(ji,jj+1) 2413 ztmpf = hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) 2414 ztmpu1 = hbatt(ji,jj)*hbatt(ji+1,jj) 2415 ztmpv1 = hbatt(ji,jj)*hbatt(ji,jj+1) 2416 ztmpf1 = MIN(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1)) * & 2417 & MAX(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1)) 2367 2418 DO jk = 1, jpk 2368 z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) ) & 2369 & / ( hbatt(ji,jj)+hbatt(ji+1,jj) ) 2370 z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) ) & 2371 & / ( hbatt(ji,jj)+hbatt(ji,jj+1) ) 2372 z_esigtf3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) & 2373 & + hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk)+hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) ) & 2374 & / ( hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) ) 2375 z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) ) & 2376 & / ( hbatt(ji,jj)+hbatt(ji+1,jj) ) 2377 z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) ) & 2378 & / ( hbatt(ji,jj)+hbatt(ji,jj+1) ) 2419 IF( ln_wd .AND. (ztmpu1 < 0._wp.OR.ABS(ztmpu) < rn_wdmin1) ) THEN 2420 z_esigtu3(ji,jj,jk) = 0.5_wp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji+1,jj,jk) ) 2421 z_esigwu3(ji,jj,jk) = 0.5_wp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji+1,jj,jk) ) 2422 ELSE 2423 z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) ) & 2424 & / ztmpu 2425 z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) ) & 2426 & / ztmpu 2427 END IF 2428 2429 IF( ln_wd .AND. (ztmpv1 < 0._wp.OR.ABS(ztmpv) < rn_wdmin1) ) THEN 2430 z_esigtv3(ji,jj,jk) = 0.5_wp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji,jj+1,jk) ) 2431 z_esigwv3(ji,jj,jk) = 0.5_wp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji,jj+1,jk) ) 2432 ELSE 2433 z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) ) & 2434 & / ztmpv 2435 z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) ) & 2436 & / ztmpv 2437 END IF 2438 2439 IF( ln_wd .AND. (ztmpf1 < 0._wp.OR.ABS(ztmpf) < rn_wdmin1) ) THEN 2440 z_esigtf3(ji,jj,jk) = 0.25_wp * ( z_esigt3(ji,jj ,jk) + z_esigt3(ji+1,jj ,jk) & 2441 & + z_esigt3(ji,jj+1,jk) + z_esigt3(ji+1,jj+1,jk) ) 2442 ELSE 2443 z_esigtf3(ji,jj,jk) = ( hbatt(ji ,jj )*z_esigt3(ji ,jj ,jk) & 2444 & + hbatt(ji+1,jj )*z_esigt3(ji+1,jj ,jk) & 2445 & + hbatt(ji ,jj+1)*z_esigt3(ji ,jj+1,jk) & 2446 & + hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) ) / ztmpf 2447 END IF 2448 2379 2449 ! 2380 2450 e3t_0(ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*z_esigt3 (ji,jj,jk) + rn_hc/REAL(jpkm1,wp) ) … … 2415 2485 REAL(wp) :: zsmth ! smoothing around critical depth 2416 2486 REAL(wp) :: zzs, zzb ! Surface and bottom cell thickness in sigma space 2487 REAL(wp) :: ztmpu, ztmpv, ztmpf 2488 REAL(wp) :: ztmpu1, ztmpv1, ztmpf1 2417 2489 ! 2418 2490 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3 … … 2493 2565 DO jj=1,jpj-1 2494 2566 2495 DO jk = 1, jpk 2496 z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) ) / & 2497 ( hbatt(ji,jj)+hbatt(ji+1,jj) ) 2498 z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) ) / & 2499 ( hbatt(ji,jj)+hbatt(ji,jj+1) ) 2500 z_esigtf3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) + & 2501 hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk)+hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) ) / & 2502 ( hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) ) 2503 z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) ) / & 2504 ( hbatt(ji,jj)+hbatt(ji+1,jj) ) 2505 z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) ) / & 2506 ( hbatt(ji,jj)+hbatt(ji,jj+1) ) 2567 ! extend to suit for Wetting/Drying case 2568 ztmpu = hbatt(ji,jj)+hbatt(ji+1,jj) 2569 ztmpv = hbatt(ji,jj)+hbatt(ji,jj+1) 2570 ztmpf = hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) 2571 ztmpu1 = hbatt(ji,jj)*hbatt(ji+1,jj) 2572 ztmpv1 = hbatt(ji,jj)*hbatt(ji,jj+1) 2573 ztmpf1 = MIN(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1)) * & 2574 & MAX(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1)) 2575 DO jk = 1, jpk 2576 IF( ln_wd .AND. (ztmpu1 < 0._wp.OR.ABS(ztmpu) < rn_wdmin1) ) THEN 2577 z_esigtu3(ji,jj,jk) = 0.5_wp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji+1,jj,jk) ) 2578 z_esigwu3(ji,jj,jk) = 0.5_wp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji+1,jj,jk) ) 2579 ELSE 2580 z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) ) & 2581 & / ztmpu 2582 z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) ) & 2583 & / ztmpu 2584 END IF 2585 2586 IF( ln_wd .AND. (ztmpv1 < 0._wp.OR.ABS(ztmpv) < rn_wdmin1) ) THEN 2587 z_esigtv3(ji,jj,jk) = 0.5_wp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji,jj+1,jk) ) 2588 z_esigwv3(ji,jj,jk) = 0.5_wp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji,jj+1,jk) ) 2589 ELSE 2590 z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) ) & 2591 & / ztmpv 2592 z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) ) & 2593 & / ztmpv 2594 END IF 2595 2596 IF( ln_wd .AND. (ztmpf1 < 0._wp.OR.ABS(ztmpf) < rn_wdmin1) ) THEN 2597 z_esigtf3(ji,jj,jk) = 0.25_wp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji+1,jj,jk) & 2598 & + z_esigt3(ji,jj+1,jk) + z_esigt3(ji+1,jj+1,jk) ) 2599 ELSE 2600 z_esigtf3(ji,jj,jk) = ( hbatt(ji ,jj )*z_esigt3(ji ,jj ,jk) & 2601 & + hbatt(ji+1,jj )*z_esigt3(ji+1,jj ,jk) & 2602 & + hbatt(ji ,jj+1)*z_esigt3(ji ,jj+1,jk) & 2603 & + hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) ) / ztmpf 2604 END IF 2605 2606 ! Code prior to wetting and drying option (for reference) 2607 !z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) ) & 2608 ! /( hbatt(ji,jj)+hbatt(ji+1,jj) ) 2609 ! 2610 !z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) ) & 2611 ! /( hbatt(ji,jj)+hbatt(ji+1,jj) ) 2612 ! 2613 !z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) ) & 2614 ! /( hbatt(ji,jj)+hbatt(ji,jj+1) ) 2615 ! 2616 !z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) ) & 2617 ! /( hbatt(ji,jj)+hbatt(ji,jj+1) ) 2618 ! 2619 !z_esigtf3(ji,jj,jk) = ( hbatt(ji ,jj )*z_esigt3(ji ,jj ,jk) & 2620 ! & +hbatt(ji+1,jj )*z_esigt3(ji+1,jj ,jk) & 2621 ! +hbatt(ji ,jj+1)*z_esigt3(ji ,jj+1,jk) & 2622 ! & +hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) ) & 2623 ! /( hbatt(ji ,jj )+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) ) 2507 2624 2508 2625 e3t_0(ji,jj,jk)=(scosrf(ji,jj)+hbatt(ji,jj))*z_esigt3(ji,jj,jk)
Note: See TracChangeset
for help on using the changeset viewer.