- Timestamp:
- 2019-11-22T15:29:17+01:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
OCE/SBC/fldread.F90 (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Property svn:mergeinfo deleted
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/fldread.F90
r11536 r11949 129 129 CONTAINS 130 130 131 SUBROUTINE fld_read( kt, kn_fsbc, sd, kit, kt_offset )131 SUBROUTINE fld_read( kt, kn_fsbc, sd, kit, kt_offset, Kmm ) 132 132 !!--------------------------------------------------------------------- 133 133 !! *** ROUTINE fld_read *** … … 149 149 ! ! kt_offset = +1 => fields at "after" time level 150 150 ! ! etc. 151 INTEGER , INTENT(in ), OPTIONAL :: Kmm ! ocean time level index 151 152 !! 152 153 INTEGER :: itmp ! local variable … … 275 276 276 277 ! read after data 277 CALL fld_get( sd(jf) ) 278 279 CALL fld_get( sd(jf), Kmm ) 278 280 279 281 ENDIF ! read new data? … … 598 600 599 601 600 SUBROUTINE fld_get( sdjf )602 SUBROUTINE fld_get( sdjf, Kmm ) 601 603 !!--------------------------------------------------------------------- 602 604 !! *** ROUTINE fld_get *** … … 605 607 !!---------------------------------------------------------------------- 606 608 TYPE(FLD) , INTENT(inout) :: sdjf ! input field related variables 609 INTEGER , INTENT(in), OPTIONAL :: Kmm ! ocean time level index 607 610 ! 608 611 INTEGER :: ipk ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) … … 676 679 END SUBROUTINE fld_get 677 680 678 679 SUBROUTINE fld_map( knum, cdvar, pdta, krec, kmap, kgrd, kbdy, ldtotvel, ldzint ) 681 SUBROUTINE fld_map( knum, cdvar, pdta, krec, kmap, kgrd, kbdy, ldtotvel, ldzint, Kmm ) 680 682 !!--------------------------------------------------------------------- 681 683 !! *** ROUTINE fld_map *** … … 694 696 LOGICAL, OPTIONAL , INTENT(in ) :: ldtotvel ! true if total ( = barotrop + barocline) velocity 695 697 LOGICAL, OPTIONAL , INTENT(in ) :: ldzint ! true if 3D variable requires a vertical interpolation 698 INTEGER, OPTIONAL , INTENT(in ) :: Kmm ! ocean time level index 696 699 !! 697 700 INTEGER :: ipi ! length of boundary data on local process … … 822 825 END SUBROUTINE fld_map_core 823 826 824 825 SUBROUTINE fld_bdy_interp(pdta_read, pdta_read_z, pdta_read_dz, pdta, kgrd, kbdy, pfv, ldtotvel) 827 SUBROUTINE fld_bdy_interp(pdta_read, pdta_read_z, pdta_read_dz, pdta, kgrd, kbdy, pfv, ldtotvel, Kmm ) 826 828 !!--------------------------------------------------------------------- 827 829 !! *** ROUTINE fld_bdy_interp *** … … 840 842 INTEGER , INTENT(in ) :: kgrd ! grid type (t, u, v) 841 843 INTEGER , INTENT(in ) :: kbdy ! bdy number 844 INTEGER, OPTIONAL , INTENT(in ) :: Kmm ! ocean time level index 842 845 !! 843 846 INTEGER :: ipi ! length of boundary data on local process … … 868 871 SELECT CASE( kgrd ) 869 872 CASE(1) 870 IF( ABS( (zh - ht _n(ji,jj)) / ht_n(ji,jj)) * tmask(ji,jj,1) > 0.01_wp ) THEN873 IF( ABS( (zh - ht(ji,jj)) / ht(ji,jj)) * tmask(ji,jj,1) > 0.01_wp ) THEN 871 874 WRITE(ctmp1,"(I10.10)") jb 872 875 CALL ctl_warn('fld_bdy_interp: T depths differ between grids at BDY point '//TRIM(ctmp1)//' by more than 1%') 873 ! IF(lwp) WRITE(numout,*) 'DEPTHT', zh, sum(e3t _n(ji,jj,:), mask=tmask(ji,jj,:)==1), ht_n(ji,jj), jb, jb, ji, jj876 ! IF(lwp) WRITE(numout,*) 'DEPTHT', zh, sum(e3t(ji,jj,:,Kmm), mask=tmask(ji,jj,:)==1), ht(ji,jj), jb, jb, ji, jj 874 877 ENDIF 875 878 CASE(2) 876 IF( ABS( (zh - hu _n(ji,jj)) * r1_hu_n(ji,jj)) * umask(ji,jj,1) > 0.01_wp ) THEN879 IF( ABS( (zh - hu(ji,jj,Kmm)) * r1_hu(ji,jj,Kmm)) * umask(ji,jj,1) > 0.01_wp ) THEN 877 880 WRITE(ctmp1,"(I10.10)") jb 878 881 CALL ctl_warn('fld_bdy_interp: U depths differ between grids at BDY point '//TRIM(ctmp1)//' by more than 1%') 879 ! IF(lwp) WRITE(numout,*) 'DEPTHU', zh, SUM(e3u _n(ji,jj,:), mask=umask(ji,jj,:)==1), SUM(umask(ji,jj,:)), &880 ! & hu _n(ji,jj), jb, jb, ji, jj, narea-1, pdta_read(jb,1,:)882 ! IF(lwp) WRITE(numout,*) 'DEPTHU', zh, SUM(e3u(ji,jj,:,Kmm), mask=umask(ji,jj,:)==1), SUM(umask(ji,jj,:)), & 883 ! & hu(ji,jj,Kmm), jb, jb, ji, jj, narea-1, pdta_read(jb,1,:) 881 884 ENDIF 882 885 CASE(3) 883 IF( ABS( (zh - hv _n(ji,jj)) * r1_hv_n(ji,jj)) * vmask(ji,jj,1) > 0.01_wp ) THEN886 IF( ABS( (zh - hv(ji,jj,Kmm)) * r1_hv(ji,jj,Kmm)) * vmask(ji,jj,1) > 0.01_wp ) THEN 884 887 WRITE(ctmp1,"(I10.10)") jb 885 888 CALL ctl_warn('fld_bdy_interp: V depths differ between grids at BDY point '//TRIM(ctmp1)//' by more than 1%') … … 890 893 CASE(1) 891 894 ! depth of T points: 892 zdepth(:) = gdept _n(ji,jj,:)895 zdepth(:) = gdept(ji,jj,:,Kmm) 893 896 CASE(2) 894 897 ! depth of U points: we must not use gdept_n as we don't want to do a communication 895 898 ! --> copy what is done for gdept_n in domvvl... 896 899 zdhalf(1) = 0.0_wp 897 zdepth(1) = 0.5_wp * e3uw _n(ji,jj,1)900 zdepth(1) = 0.5_wp * e3uw(ji,jj,1,Kmm) 898 901 DO jk = 2, jpk ! vertical sum 899 902 ! zcoef = umask - wumask ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt … … 902 905 !!gm ??????? BUG ? gdept_n as well as gde3w_n does not include the thickness of ISF ?? 903 906 zcoef = ( umask(ji,jj,jk) - wumask(ji,jj,jk) ) 904 zdhalf(jk) = zdhalf(jk-1) + e3u _n(ji,jj,jk-1)905 zdepth(jk) = zcoef * ( zdhalf(jk ) + 0.5 * e3uw _n(ji,jj,jk)) &906 & + (1-zcoef) * ( zdepth(jk-1) + e3uw_n(ji,jj,jk))907 zdhalf(jk) = zdhalf(jk-1) + e3u(ji,jj,jk-1,Kmm) 908 zdepth(jk) = zcoef * ( zdhalf(jk ) + 0.5 * e3uw(ji,jj,jk,Kmm)) & 909 & + (1-zcoef) * ( zdepth(jk-1) + e3uw(ji,jj,jk,Kmm)) 907 910 END DO 908 911 CASE(3) … … 910 913 ! --> copy what is done for gdept_n in domvvl... 911 914 zdhalf(1) = 0.0_wp 912 zdepth(1) = 0.5_wp * e3vw _n(ji,jj,1)915 zdepth(1) = 0.5_wp * e3vw(ji,jj,1,Kmm) 913 916 DO jk = 2, jpk ! vertical sum 914 917 ! zcoef = vmask - wvmask ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt … … 917 920 !!gm ??????? BUG ? gdept_n as well as gde3w_n does not include the thickness of ISF ?? 918 921 zcoef = ( vmask(ji,jj,jk) - wvmask(ji,jj,jk) ) 919 zdhalf(jk) = zdhalf(jk-1) + e3v _n(ji,jj,jk-1)920 zdepth(jk) = zcoef * ( zdhalf(jk ) + 0.5 * e3vw _n(ji,jj,jk)) &921 & + (1-zcoef) * ( zdepth(jk-1) + e3vw_n(ji,jj,jk))922 zdhalf(jk) = zdhalf(jk-1) + e3v(ji,jj,jk-1,Kmm) 923 zdepth(jk) = zcoef * ( zdhalf(jk ) + 0.5 * e3vw(ji,jj,jk,Kmm)) & 924 & + (1-zcoef) * ( zdepth(jk-1) + e3vw(ji,jj,jk,Kmm)) 922 925 END DO 923 926 END SELECT … … 952 955 ENDDO 953 956 DO jk = 1, jpk ! calculate transport on model grid 954 ztrans_new = ztrans_new + pdta(jb,1,jk ) * e3u _n(ji,jj,jk) * umask(ji,jj,jk)957 ztrans_new = ztrans_new + pdta(jb,1,jk ) * e3u(ji,jj,jk,Kmm ) * umask(ji,jj,jk) 955 958 ENDDO 956 959 DO jk = 1, jpk ! make transport correction 957 960 IF(ldtotvel) THEN ! bdy data are total velocity so adjust bt transport term to match input data 958 pdta(jb,1,jk) = ( pdta(jb,1,jk) + ( ztrans - ztrans_new ) * r1_hu _n(ji,jj) ) * umask(ji,jj,jk)961 pdta(jb,1,jk) = ( pdta(jb,1,jk) + ( ztrans - ztrans_new ) * r1_hu(ji,jj,Kmm) ) * umask(ji,jj,jk) 959 962 ELSE ! we're just dealing with bc velocity so bt transport term should sum to zero 960 pdta(jb,1,jk) = pdta(jb,1,jk) + ( 0._wp - ztrans_new ) * r1_hu _n(ji,jj) * umask(ji,jj,jk)963 pdta(jb,1,jk) = pdta(jb,1,jk) + ( 0._wp - ztrans_new ) * r1_hu(ji,jj,Kmm) * umask(ji,jj,jk) 961 964 ENDIF 962 965 ENDDO … … 975 978 ENDDO 976 979 DO jk = 1, jpk ! calculate transport on model grid 977 ztrans_new = ztrans_new + pdta(jb,1,jk ) * e3v _n(ji,jj,jk) * vmask(ji,jj,jk)980 ztrans_new = ztrans_new + pdta(jb,1,jk ) * e3v(ji,jj,jk,Kmm ) * vmask(ji,jj,jk) 978 981 ENDDO 979 982 DO jk = 1, jpk ! make transport correction 980 983 IF(ldtotvel) THEN ! bdy data are total velocity so adjust bt transport term to match input data 981 pdta(jb,1,jk) = ( pdta(jb,1,jk) + ( ztrans - ztrans_new ) * r1_hv _n(ji,jj) ) * vmask(ji,jj,jk)984 pdta(jb,1,jk) = ( pdta(jb,1,jk) + ( ztrans - ztrans_new ) * r1_hv(ji,jj,Kmm) ) * vmask(ji,jj,jk) 982 985 ELSE ! we're just dealing with bc velocity so bt transport term should sum to zero 983 pdta(jb,1,jk) = pdta(jb,1,jk) + ( 0._wp - ztrans_new ) * r1_hv _n(ji,jj) * vmask(ji,jj,jk)986 pdta(jb,1,jk) = pdta(jb,1,jk) + ( 0._wp - ztrans_new ) * r1_hv(ji,jj,Kmm) * vmask(ji,jj,jk) 984 987 ENDIF 985 988 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.
