Changeset 4792 for branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
- Timestamp:
- 2014-09-26T13:04:47+02:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r4694 r4792 40 40 LOGICAL :: ln_clim ! climatology or not (T/F) 41 41 CHARACTER(len = 8) :: cltype ! type of data file 'daily', 'monthly' or yearly' 42 CHARACTER(len = 34):: wname ! generic name of a NetCDF weights file to be used, blank if not42 CHARACTER(len = 256) :: wname ! generic name of a NetCDF weights file to be used, blank if not 43 43 CHARACTER(len = 34) :: vcomp ! symbolic component name if a vector that needs rotation 44 44 ! ! a string starting with "U" or "V" for each component … … 489 489 ! forcing record : 1 490 490 ! 491 ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5 + REAL( it_offset, wp ) 491 ztmp = REAL( nsec_year, wp ) / ( REAL( nyear_len(1), wp ) * rday ) + 0.5 & 492 & + REAL( it_offset, wp ) / ( REAL( nyear_len(1), wp ) * rday ) 492 493 sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 493 494 ! swap at the middle of the year 494 IF( llbefore ) THEN ; sdjf%nrec_a(2) = nsec1jan000 - NINT(0.5 * rday) * nyear_len(0) 495 ELSE ; sdjf%nrec_a(2) = nsec1jan000 + NINT(0.5 * rday) * nyear_len(1) 495 IF( llbefore ) THEN ; sdjf%nrec_a(2) = nsec1jan000 - (1 - INT(ztmp)) * NINT(0.5 * rday) * nyear_len(0) + & 496 & INT(ztmp) * NINT( 0.5 * rday) * nyear_len(1) 497 ELSE ; sdjf%nrec_a(2) = nsec1jan000 + (1 - INT(ztmp)) * NINT(0.5 * rday) * nyear_len(1) + & 498 & INT(ztmp) * INT(rday) * nyear_len(1) + INT(ztmp) * NINT( 0.5 * rday) * nyear_len(2) 496 499 ENDIF 497 500 ELSE ! no time interpolation … … 517 520 ! forcing record : nmonth 518 521 ! 519 ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 + REAL( it_offset, wp ) 522 ztmp = REAL( nsec_month, wp ) / ( REAL( nmonth_len(nmonth), wp ) * rday ) + 0.5 & 523 & + REAL( it_offset, wp ) / ( REAL( nmonth_len(nmonth), wp ) * rday ) 520 524 imth = nmonth + INT( ztmp ) - COUNT((/llbefore/)) 521 525 IF( sdjf%cltype == 'monthly' ) THEN ; sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) … … 689 693 !!---------------------------------------------------------------------- 690 694 #if defined key_bdy 691 USE bdy_oce, ONLY: dta_global, dta_global 2! workspace to read in global data arrays695 USE bdy_oce, ONLY: dta_global, dta_global_z, dta_global2, dta_global2_z ! workspace to read in global data arrays 692 696 #endif 693 697 INTEGER , INTENT(in ) :: num ! stream number … … 706 710 INTEGER :: ib, ik, ji, jj ! loop counters 707 711 INTEGER :: ierr 712 REAL(wp) :: fv ! fillvalue and alternative -ABS(fv) 708 713 REAL(wp), POINTER, DIMENSION(:,:,:) :: dta_read ! work space for global data 709 714 REAL(wp), POINTER, DIMENSION(:,:,:) :: dta_read_z ! work space for global data … … 753 758 END SELECT 754 759 CALL iom_getatt(num, '_FillValue', fv, cdvar=clvar ) 760 #if defined key_bdy 755 761 CALL fld_bdy_interp(dta_read, dta_read_z, map, jpk_bdy, igrd, ibdy, fv, dta) 762 #endif 756 763 ELSE ! boundary data assumed to be on model grid 757 764 CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1:ipk), nrec ) … … 776 783 END SUBROUTINE fld_map 777 784 785 #if defined key_bdy 778 786 SUBROUTINE fld_bdy_interp(dta_read, dta_read_z, map, jpk_bdy, igrd, ibdy, fv, dta) 779 787 … … 784 792 !! boundary data from non-native vertical grid 785 793 !!---------------------------------------------------------------------- 786 #if defined key_bdy787 794 USE bdy_oce, ONLY: idx_bdy ! indexing for map <-> ij transformation 788 #endif789 795 790 796 REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(in ) :: dta_read ! work space for global data … … 792 798 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: dta ! output field on model grid (2 dimensional) 793 799 INTEGER, DIMENSION(:) , INTENT(in ) :: map ! global-to-local mapping indices 794 INTEGER , INTENT(in) :: igrd, ib _bdy, jpk_bdy ! number of levels in bdy data800 INTEGER , INTENT(in) :: igrd, ibdy, jpk_bdy ! number of levels in bdy data 795 801 INTEGER :: jpkm1_bdy ! number of levels in bdy data minus 1 802 REAL(wp) , INTENT(in) :: fv ! fillvalue and alternative -ABS(fv) 796 803 !! 797 804 INTEGER :: ipi ! length of boundary data on local process … … 800 807 INTEGER :: ilendta ! length of data in file 801 808 INTEGER :: ib, ik, ikk! loop counters 809 INTEGER :: ji, jj ! loop counters 802 810 REAL(wp) :: zl, zi ! tmp variable for current depth and interpolation factor 803 REAL(wp) :: fv , fv_alt ! fillvalue and alternative -ABS(fv)811 REAL(wp) :: fv_alt ! fillvalue and alternative -ABS(fv) 804 812 !!--------------------------------------------------------------------- 805 813 … … 824 832 DO ib = 1, ipi 825 833 DO ik = 1, ipk 826 zl = gdept_ 1(idx_bdy(ib_bdy)%nbi(ib,igrd),idx_bdy(ib_bdy)%nbj(ib,igrd),ik) ! if using in step could use fsdept instead of gdept_1?834 zl = gdept_0(idx_bdy(ibdy)%nbi(ib,igrd),idx_bdy(ibdy)%nbj(ib,igrd),ik) ! if using in step could use fsdept instead of gdept_0? 827 835 IF( zl < dta_read_z(map(ib),1,1) ) THEN ! above the first level of external data 828 836 dta(ib,1,ik) = dta_read(map(ib),1,1) … … 830 838 dta(ib,1,ik) = dta_read(map(ib),1,MAXLOC(dta_read_z(map(ib),1,:),1)) 831 839 ELSE ! inbetween : vertical interpolation between ikk & ikk+1 832 DO ikk = 1, jpkm1_bdy ! when gdept_ 1(ikk) < zl < gdept_1(ikk+1)840 DO ikk = 1, jpkm1_bdy ! when gdept_0(ikk) < zl < gdept_0(ikk+1) 833 841 IF( ( (zl-dta_read_z(map(ib),1,ikk)) * (zl-dta_read_z(map(ib),1,ikk+1)) <= 0._wp) & 834 842 & .AND. (dta_read_z(map(ib),1,ikk+1) /= fv_alt)) THEN … … 857 865 ji=map(ib)-(jj-1)*ilendta 858 866 DO ik = 1, ipk 859 zl = gdept_ 1(idx_bdy(ib_bdy)%nbi(ib,igrd),idx_bdy(ib_bdy)%nbj(ib,igrd),ik) ! if using in step could use fsdept instead of gdept_1?867 zl = gdept_0(idx_bdy(ibdy)%nbi(ib,igrd),idx_bdy(ibdy)%nbj(ib,igrd),ik) ! if using in step could use fsdept instead of gdept_0? 860 868 IF( zl < dta_read_z(ji,jj,1) ) THEN ! above the first level of external data 861 dta(ib,1,ik) = dta_read(ji,jj,1 ,1)869 dta(ib,1,ik) = dta_read(ji,jj,1) 862 870 ELSEIF( zl > MAXVAL(dta_read_z(ji,ji,:),1) ) THEN ! below the last level of external data 863 871 dta(ib,1,ik) = dta_read(ji,jj,MAXLOC(dta_read_z(ji,jj,:),1)) 864 872 ELSE ! inbetween : vertical interpolation between ikk & ikk+1 865 DO ikk = 1, jpkm1_bdy ! when gdept_ 1(ikk) < zl < gdept_1(ikk+1)873 DO ikk = 1, jpkm1_bdy ! when gdept_0(ikk) < zl < gdept_0(ikk+1) 866 874 IF( ( (zl-dta_read_z(ji,jj,ikk)) * (zl-dta_read_z(ji,jj,ikk+1)) <= 0._wp) & 867 875 & .AND. (dta_read_z(ji,jj,ikk+1) /= fv_alt)) THEN 868 876 zi = ( zl - dta_read_z(ji,jj,ikk) ) / (dta_read_z(ji,jj,ikk+1)-dta_read_z(ji,jj,ikk)) 869 877 dta(ib,1,ik) = dta_read(ji,jj,ikk) + & 870 & ( dta_read(ji,jj, 1,ikk+1) - dta_read(ji,jj,ikk) ) * zi878 & ( dta_read(ji,jj,ikk+1) - dta_read(ji,jj,ikk) ) * zi 871 879 ENDIF 872 880 END DO … … 877 885 878 886 END SUBROUTINE fld_bdy_interp 887 #endif 879 888 880 889 SUBROUTINE fld_rot( kt, sd )
Note: See TracChangeset
for help on using the changeset viewer.
