- Timestamp:
- 2020-10-22T20:49:56+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11842_SI3-10_EAP
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/SBC/fldread.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11842_SI3-10_EAP
- Property svn:externals
-
old new 1 ^/utils/build/arch@HEAD arch 2 ^/utils/build/makenemo@HEAD makenemo 3 ^/utils/build/mk@HEAD mk 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev@HEAD ext/AGRIF 6 ^/vendors/FCM@HEAD ext/FCM 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 1 ^/utils/build/arch@12130 arch 2 ^/utils/build/makenemo@12191 makenemo 3 ^/utils/build/mk@11662 mk 4 ^/utils/tools_r4.0-HEAD@12672 tools 5 ^/vendors/AGRIF/dev@10586 ext/AGRIF 6 ^/vendors/FCM@10134 ext/FCM 7 ^/vendors/IOIPSL@9655 ext/IOIPSL 8 9 # SETTE mapping (inactive) 10 #^/utils/CI/sette@12135 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11842_SI3-10_EAP/src/OCE/SBC/fldread.F90
r11536 r13662 833 833 834 834 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pdta_read ! data read in bdy file 835 REAL(wp), DIMENSION(:,:,:), INTENT(in out) :: pdta_read_z ! depth of the data read in bdy file836 REAL(wp), DIMENSION(:,:,:), INTENT(in out) :: pdta_read_dz ! thickness of the levels in bdy file835 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pdta_read_z ! depth of the data read in bdy file 836 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pdta_read_dz ! thickness of the levels in bdy file 837 837 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pdta ! output field on model grid (2 dimensional) 838 838 REAL(wp) , INTENT(in ) :: pfv ! fillvalue of the data read in bdy file … … 841 841 INTEGER , INTENT(in ) :: kbdy ! bdy number 842 842 !! 843 INTEGER :: ipi! length of boundary data on local process844 INTEGER :: ipkb! number of vertical levels in boundary data file845 INTEGER :: jb, ji, jj, jk, jkb ! loop counters846 REAL(wp) :: zcoef847 REAL(wp) :: zl, zi, zh ! tmp variable for current depth and interpolation factor848 REAL(wp) :: zfv_alt, ztrans, ztrans_new ! fillvalue and alternative -ABS(pfv)849 REAL(wp), DIMENSION(jpk) :: zdepth, zdhalf! level and half-level depth843 INTEGER :: ipi ! length of boundary data on local process 844 INTEGER :: ipkb ! number of vertical levels in boundary data file 845 INTEGER :: ipkmax ! number of vertical levels in boundary data file where no mask 846 INTEGER :: jb, ji, jj, jk, jkb ! loop counters 847 REAL(wp) :: zcoef, zi ! 848 REAL(wp) :: ztrans, ztrans_new ! transports 849 REAL(wp), DIMENSION(jpk) :: zdepth, zdhalf ! level and half-level depth 850 850 !!--------------------------------------------------------------------- 851 851 … … 853 853 ipkb = SIZE( pdta_read, 3 ) 854 854 855 zfv_alt = -ABS(pfv) ! set _FillValue < 0 as we make use of MAXVAL and MAXLOC later856 !857 WHERE( pdta_read == pfv )858 pdta_read_z = zfv_alt ! safety: put fillvalue into external depth field so consistent with data859 pdta_read_dz = 0._wp ! safety: put 0._wp into external thickness factors to ensure transport is correct860 ENDWHERE861 862 855 DO jb = 1, ipi 863 856 ji = idx_bdy(kbdy)%nbi(jb,kgrd) 864 857 jj = idx_bdy(kbdy)%nbj(jb,kgrd) 865 zh = SUM(pdta_read_dz(jb,1,:) ) 866 ! 867 ! Warnings to flag differences in the input and model topgraphy - is this useful/necessary? 858 ! 859 ! --- max jk where input data /= FillValue --- ! 860 ipkmax = 1 861 DO jkb = 2, ipkb 862 IF( pdta_read(jb,1,jkb) /= pfv ) ipkmax = MAX( ipkmax, jkb ) 863 END DO 864 ! 865 ! --- calculate depth at t,u,v points --- ! 868 866 SELECT CASE( kgrd ) 869 CASE(1) 870 IF( ABS( (zh - ht_n(ji,jj)) / ht_n(ji,jj)) * tmask(ji,jj,1) > 0.01_wp ) THEN 871 WRITE(ctmp1,"(I10.10)") jb 872 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, jj 874 ENDIF 875 CASE(2) 876 IF( ABS( (zh - hu_n(ji,jj)) * r1_hu_n(ji,jj)) * umask(ji,jj,1) > 0.01_wp ) THEN 877 WRITE(ctmp1,"(I10.10)") jb 878 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,:) 881 ENDIF 882 CASE(3) 883 IF( ABS( (zh - hv_n(ji,jj)) * r1_hv_n(ji,jj)) * vmask(ji,jj,1) > 0.01_wp ) THEN 884 WRITE(ctmp1,"(I10.10)") jb 885 CALL ctl_warn('fld_bdy_interp: V depths differ between grids at BDY point '//TRIM(ctmp1)//' by more than 1%') 886 ENDIF 887 END SELECT 888 ! 889 SELECT CASE( kgrd ) 890 CASE(1) 891 ! depth of T points: 867 CASE(1) ! depth of T points: 892 868 zdepth(:) = gdept_n(ji,jj,:) 893 CASE(2) 894 ! depth of U points: we must not use gdept_n as we don't want to do a communication 895 ! --> copy what is done for gdept_n in domvvl... 869 CASE(2) ! depth of U points: we must not use gdept_n as we don't want to do a communication 870 ! --> copy what is done for gdept_n in domvvl... 896 871 zdhalf(1) = 0.0_wp 897 872 zdepth(1) = 0.5_wp * e3uw_n(ji,jj,1) … … 903 878 zcoef = ( umask(ji,jj,jk) - wumask(ji,jj,jk) ) 904 879 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))880 zdepth(jk) = zcoef * ( zdhalf(jk ) + 0.5 * e3uw_n(ji,jj,jk)) & 881 & + (1.-zcoef) * ( zdepth(jk-1) + e3uw_n(ji,jj,jk)) 907 882 END DO 908 CASE(3) 909 ! depth of V points: we must not use gdept_n as we don't want to do a communication 910 ! --> copy what is done for gdept_n in domvvl... 883 CASE(3) ! depth of V points: we must not use gdept_n as we don't want to do a communication 884 ! --> copy what is done for gdept_n in domvvl... 911 885 zdhalf(1) = 0.0_wp 912 886 zdepth(1) = 0.5_wp * e3vw_n(ji,jj,1) … … 918 892 zcoef = ( vmask(ji,jj,jk) - wvmask(ji,jj,jk) ) 919 893 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))894 zdepth(jk) = zcoef * ( zdhalf(jk ) + 0.5 * e3vw_n(ji,jj,jk)) & 895 & + (1.-zcoef) * ( zdepth(jk-1) + e3vw_n(ji,jj,jk)) 922 896 END DO 923 897 END SELECT 924 ! 925 DO jk = 1, jpk926 IF( zdepth(jk) < pdta_read_z(jb,1, 1) ) THEN ! above the first level of external data927 pdta(jb,1,jk) = pdta_read(jb,1,1)928 ELSEIF( zdepth(jk) > pdta_read_z(jb,1,ipkb) ) THEN ! below the last level of external data929 pdta(jb,1,jk) = pdta_read(jb,1,MAXLOC(pdta_read_z(jb,1,:),1))930 ELSE ! inbetween: vertical interpolation between jkb & jkb+1931 DO jkb = 1, ipkb-1 ! when gdept_n(jkb) < zdepth(jk) < gdept_n(jkb+1)932 IF( ( ( zdepth(jk) - pdta_read_z(jb,1,jkb) ) * ( zdepth(jk) - pdta_read_z(jb,1,jkb+1) ) <= 0._wp ) &933 & .AND. ( pdta_read_z(jb,1,jkb+1) /= zfv_alt) ) THEN! linear interpolation between 2 levels898 ! 899 ! --- interpolate bdy data on the model grid --- ! 900 DO jk = 1, jpk 901 IF( zdepth(jk) <= pdta_read_z(jb,1,1) ) THEN ! above the first level of external data 902 pdta(jb,1,jk) = pdta_read(jb,1,1) 903 ELSEIF( zdepth(jk) > pdta_read_z(jb,1,ipkmax) ) THEN ! below the last level of external data /= FillValue 904 pdta(jb,1,jk) = pdta_read(jb,1,ipkmax) 905 ELSE ! inbetween: vertical interpolation between jkb & jkb+1 906 DO jkb = 1, ipkmax-1 907 IF( ( ( zdepth(jk) - pdta_read_z(jb,1,jkb) ) * ( zdepth(jk) - pdta_read_z(jb,1,jkb+1) ) ) <= 0._wp ) THEN ! linear interpolation between 2 levels 934 908 zi = ( zdepth(jk) - pdta_read_z(jb,1,jkb) ) / ( pdta_read_z(jb,1,jkb+1) - pdta_read_z(jb,1,jkb) ) 935 pdta(jb,1,jk) = pdta_read(jb,1,jkb) + ( pdta_read (jb,1,jkb+1) - pdta_read (jb,1,jkb) ) * zi909 pdta(jb,1,jk) = pdta_read(jb,1,jkb) + zi * ( pdta_read(jb,1,jkb+1) - pdta_read(jb,1,jkb) ) 936 910 ENDIF 937 911 END DO 938 912 ENDIF 939 END DO ! jpk913 END DO 940 914 ! 941 915 END DO ! ipi 942 943 IF(kgrd == 2) THEN ! do we need to adjust the transport term? 916 917 ! --- mask data and adjust transport --- ! 918 SELECT CASE( kgrd ) 919 920 CASE(1) ! mask data (probably unecessary) 944 921 DO jb = 1, ipi 945 922 ji = idx_bdy(kbdy)%nbi(jb,kgrd) 946 923 jj = idx_bdy(kbdy)%nbj(jb,kgrd) 947 zh = SUM(pdta_read_dz(jb,1,:) ) 924 DO jk = 1, jpk 925 pdta(jb,1,jk) = pdta(jb,1,jk) * tmask(ji,jj,jk) 926 END DO 927 END DO 928 929 CASE(2) ! adjust the U-transport term 930 DO jb = 1, ipi 931 ji = idx_bdy(kbdy)%nbi(jb,kgrd) 932 jj = idx_bdy(kbdy)%nbj(jb,kgrd) 948 933 ztrans = 0._wp 934 DO jkb = 1, ipkb ! calculate transport on input grid 935 IF( pdta_read(jb,1,jkb) /= pfv ) ztrans = ztrans + pdta_read(jb,1,jkb) * pdta_read_dz(jb,1,jkb) 936 ENDDO 949 937 ztrans_new = 0._wp 950 DO jkb = 1, ipkb ! calculate transport on input grid951 ztrans = ztrans + pdta_read(jb,1,jkb) * pdta_read_dz(jb, 1,jkb)952 ENDDO953 938 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)939 ztrans_new = ztrans_new + pdta(jb,1,jk ) * e3u_n(ji,jj,jk) * umask(ji,jj,jk) 955 940 ENDDO 956 941 DO jk = 1, jpk ! make transport correction 957 942 IF(ldtotvel) THEN ! bdy data are total velocity so adjust bt transport term to match input data 958 943 pdta(jb,1,jk) = ( pdta(jb,1,jk) + ( ztrans - ztrans_new ) * r1_hu_n(ji,jj) ) * umask(ji,jj,jk) 959 ELSE ! we're just dealing with bc velocity so bt transport term should sum to zero960 pdta(jb,1,jk) = pdta(jb,1,jk) + ( 0._wp - ztrans_new ) * r1_hu_n(ji,jj)* umask(ji,jj,jk)944 ELSE ! we're just dealing with bc velocity so bt transport term should sum to zero 945 pdta(jb,1,jk) = ( pdta(jb,1,jk) + ( 0._wp - ztrans_new ) * r1_hu_n(ji,jj) ) * umask(ji,jj,jk) 961 946 ENDIF 962 947 ENDDO 963 948 ENDDO 964 ENDIF 965 966 IF(kgrd == 3) THEN ! do we need to adjust the transport term? 949 950 CASE(3) ! adjust the V-transport term 967 951 DO jb = 1, ipi 968 952 ji = idx_bdy(kbdy)%nbi(jb,kgrd) 969 953 jj = idx_bdy(kbdy)%nbj(jb,kgrd) 970 zh = SUM(pdta_read_dz(jb,1,:) )971 954 ztrans = 0._wp 955 DO jkb = 1, ipkb ! calculate transport on input grid 956 IF( pdta_read(jb,1,jkb) /= pfv ) ztrans = ztrans + pdta_read(jb,1,jkb) * pdta_read_dz(jb,1,jkb) 957 ENDDO 972 958 ztrans_new = 0._wp 973 DO jkb = 1, ipkb ! calculate transport on input grid974 ztrans = ztrans + pdta_read(jb,1,jkb) * pdta_read_dz(jb, 1,jkb)975 ENDDO976 959 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)960 ztrans_new = ztrans_new + pdta(jb,1,jk ) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk) 978 961 ENDDO 979 962 DO jk = 1, jpk ! make transport correction 980 963 IF(ldtotvel) THEN ! bdy data are total velocity so adjust bt transport term to match input data 981 964 pdta(jb,1,jk) = ( pdta(jb,1,jk) + ( ztrans - ztrans_new ) * r1_hv_n(ji,jj) ) * vmask(ji,jj,jk) 982 ELSE ! we're just dealing with bc velocity so bt transport term should sum to zero983 pdta(jb,1,jk) = pdta(jb,1,jk) + ( 0._wp - ztrans_new ) * r1_hv_n(ji,jj)* vmask(ji,jj,jk)965 ELSE ! we're just dealing with bc velocity so bt transport term should sum to zero 966 pdta(jb,1,jk) = ( pdta(jb,1,jk) + ( 0._wp - ztrans_new ) * r1_hv_n(ji,jj) ) * vmask(ji,jj,jk) 984 967 ENDIF 985 968 ENDDO 986 969 ENDDO 987 END IF988 970 END SELECT 971 989 972 END SUBROUTINE fld_bdy_interp 990 973 991 974 992 975 SUBROUTINE fld_rot( kt, sd ) 993 976 !!---------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
