- Timestamp:
- 2016-07-19T10:38:35+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/interp_cubic.f90
r5037 r6808 26 26 ! REVISION HISTORY: 27 27 !> @date September, 2014 -Initial version 28 !> @date June, 2015 29 !> - use math module 28 30 !> 29 31 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 36 38 USE logger ! log file manager 37 39 USE fct ! basic useful function 38 USE extrap ! extrapolation manager40 USE math ! mathematical function 39 41 40 42 IMPLICIT NONE … … 61 63 !> 62 64 !> @author J.Paul 63 !> - September, 2014- Initial Version 65 !> @date September, 2014 - Initial Version 66 !> @date July, 2015 67 !> - reinitialise detect array for each level 64 68 !> 65 69 !> @param[inout] dd_value 2D array of variable value … … 82 86 83 87 ! local variable 84 INTEGER(i4), DIMENSION(4) :: il_shape 85 86 LOGICAL :: ll_discont 87 88 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_weight_IJ 89 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_weight_I 90 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_weight_J 88 INTEGER(i4), DIMENSION(4) :: il_shape 89 90 INTEGER(I4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect 91 92 LOGICAL :: ll_discont 93 94 REAL(dp) , DIMENSION(:,:) , ALLOCATABLE :: dl_weight_IJ 95 REAL(dp) , DIMENSION(:,:) , ALLOCATABLE :: dl_weight_I 96 REAL(dp) , DIMENSION(:,:) , ALLOCATABLE :: dl_weight_J 91 97 92 98 ! loop indices … … 113 119 & id_rho(jp_J), ld_even(jp_J)) 114 120 121 ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3))) 122 115 123 DO jl=1,il_shape(4) 124 il_detect(:,:,:)=id_detect(:,:,:) 116 125 ! loop on vertical level 117 126 DO jk=1,il_shape(3) … … 119 128 ! I-J plan 120 129 CALL interp_cubic__2D(dd_value(:,:,jk,jl), dd_fill, & 121 & i d_detect(:,:,jk), &130 & il_detect(:,:,jk), & 122 131 & dl_weight_IJ(:,:), & 123 132 & id_rho(jp_I), id_rho(jp_J), & 124 133 & ll_discont) 125 IF( ANY(i d_detect(:,:,jk)==1) )THEN134 IF( ANY(il_detect(:,:,jk)==1) )THEN 126 135 ! I direction 127 136 DO jj=1,il_shape(2) 128 137 CALL interp_cubic__1D( dd_value(:,jj,jk,jl), dd_fill, & 129 & i d_detect(:,jj,jk), &138 & il_detect(:,jj,jk), & 130 139 & dl_weight_I(:,:), & 131 140 & id_rho(jp_I), ll_discont ) 132 141 ENDDO 133 IF( ALL(i d_detect(:,:,jk)==0) )THEN142 IF( ALL(il_detect(:,:,jk)==0) )THEN 134 143 CYCLE 135 144 ELSE … … 137 146 DO ji=1,il_shape(1) 138 147 CALL interp_cubic__1D( dd_value(ji,:,jk,jl), dd_fill, & 139 & i d_detect(ji,:,jk), &148 & il_detect(ji,:,jk), & 140 149 & dl_weight_J(:,:), & 141 150 & id_rho(jp_J), ll_discont ) … … 147 156 ENDDO 148 157 158 id_detect(:,:,:)=il_detect(:,:,:) 159 DEALLOCATE(il_detect) 160 149 161 DEALLOCATE(dl_weight_IJ) 150 162 DEALLOCATE(dl_weight_I) … … 159 171 !> 160 172 !> @author J.Paul 161 !> - September, 2014- Initial Version173 !> @date September, 2014 - Initial Version 162 174 !> 163 175 !> @param[inout] dd_value 2D array of variable value … … 181 193 REAL(dp) , INTENT(IN ) :: dd_fill 182 194 INTEGER(I4) , DIMENSION(:,:), INTENT(INOUT) :: id_detect 183 REAL(dp) , DIMENSION(:,:), INTENT(IN ) :: dd_weight 195 REAL(dp) , DIMENSION(:,:), INTENT(IN ) :: dd_weight 184 196 INTEGER(I4) , INTENT(IN ) :: id_rhoi 185 197 INTEGER(I4) , INTENT(IN ) :: id_rhoj … … 230 242 231 243 ! compute derivative on coarse grid 232 dl_dfdx(:,:)= extrap_deriv_2D(dl_coarse(:,:), dd_fill, 'I', ld_discont)233 dl_dfdy(:,:)= extrap_deriv_2D(dl_coarse(:,:), dd_fill, 'J', ld_discont)244 dl_dfdx(:,:)=math_deriv_2D(dl_coarse(:,:), dd_fill, 'I', ld_discont) 245 dl_dfdy(:,:)=math_deriv_2D(dl_coarse(:,:), dd_fill, 'J', ld_discont) 234 246 235 247 ! compute cross derivative on coarse grid 236 dl_d2fdxy(:,:)= extrap_deriv_2D(dl_dfdx(:,:), dd_fill, 'J', ld_discont)248 dl_d2fdxy(:,:)=math_deriv_2D(dl_dfdx(:,:), dd_fill, 'J', ld_discont) 237 249 238 250 ALLOCATE( dl_tmp(2,2) ) … … 319 331 !> 320 332 !> @author J.Paul 321 !> - September, 2014- Initial Version333 !> @date September, 2014 - Initial Version 322 334 !> 323 335 !> @param[inout] dd_value 1D array of variable value … … 339 351 REAL(dp) , INTENT(IN ) :: dd_fill 340 352 INTEGER(I4) , DIMENSION(:) , INTENT(INOUT) :: id_detect 341 REAL(dp) , DIMENSION(:,:), INTENT(IN ) :: dd_weight 353 REAL(dp) , DIMENSION(:,:), INTENT(IN ) :: dd_weight 342 354 INTEGER(I4) , INTENT(IN ) :: id_rhoi 343 355 LOGICAL , INTENT(IN ) :: ld_discont … … 376 388 377 389 ! compute derivative on coarse grid 378 dl_dfdx(:)= extrap_deriv_1D(dl_coarse(:), dd_fill, ld_discont)390 dl_dfdx(:)=math_deriv_1D(dl_coarse(:), dd_fill, ld_discont) 379 391 380 392 ALLOCATE( dl_tmp(2) ) … … 440 452 !> 441 453 !> @author J.Paul 442 !> - September, 2014- Initial Version454 !> @date September, 2014 - Initial Version 443 455 !> 444 456 !> @param[in] dd_value 2D array of value … … 503 515 !> 504 516 !> @author J.Paul 505 !> - September, 2014- Initial Version517 !> @date September, 2014 - Initial Version 506 518 !> 507 519 !> @param[inout] dd_value 2D array of mixed grid value … … 565 577 !> 566 578 !> @author J.Paul 567 !> - September, 2014- Initial Version579 !> @date September, 2014 - Initial Version 568 580 !> 569 581 !> @param[in] dd_value 1D array of value … … 608 620 !> 609 621 !> @author J.Paul 610 !> - September, 2014- Initial Version622 !> @date September, 2014 - Initial Version 611 623 !> 612 624 !> @param[inout] dd_value 1D array of mixed grid value … … 659 671 !> 660 672 !> @author J.Paul 661 !> - September, 2014- Initial Version673 !> @date September, 2014 - Initial Version 662 674 !> 663 675 !> @param[in] dd_weight interpolation weight of 2D array … … 740 752 !> 741 753 !> @author J.Paul 742 !> - September, 2014- Initial Version754 !> @date September, 2014 - Initial Version 743 755 !> 744 756 !> @param[in] dd_weight interpolation weight of 1D array
Note: See TracChangeset
for help on using the changeset viewer.