Changeset 5948 for branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90
- Timestamp:
- 2015-11-30T11:47:24+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90
r5947 r5948 24 24 !> J.Paul 25 25 ! REVISION HISTORY: 26 !> @date September, 2014 - Initial version26 !> @date September, 2014 - Initial version 27 27 !> 28 28 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 63 63 !> 64 64 !> @author J.Paul 65 !> - September, 2014- Initial Version 65 !> @date September, 2014 - Initial Version 66 !> @date July, 2015 - reinitialise detect array for each level 66 67 !> 67 68 !> @param[inout] dd_value 2D array of variable value … … 84 85 85 86 ! local variable 86 INTEGER(i4), DIMENSION(4) :: il_shape 87 88 LOGICAL :: ll_discont 89 90 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_weight_IJ 91 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_weight_I 92 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_weight_J 87 INTEGER(i4), DIMENSION(4) :: il_shape 88 89 INTEGER(I4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect 90 91 LOGICAL :: ll_discont 92 93 REAL(dp) , DIMENSION(:,:) , ALLOCATABLE :: dl_weight_IJ 94 REAL(dp) , DIMENSION(:,:) , ALLOCATABLE :: dl_weight_I 95 REAL(dp) , DIMENSION(:,:) , ALLOCATABLE :: dl_weight_J 93 96 94 97 ! loop indices … … 104 107 105 108 ! compute vect2D 106 ALLOCATE(dl_weight_IJ( 16,((id_rho(jp_I)+1)*(id_rho(jp_J)+1))) )109 ALLOCATE(dl_weight_IJ(4,((id_rho(jp_I)+1)*(id_rho(jp_J)+1))) ) 107 110 CALL interp_linear__get_weight2D(dl_weight_IJ(:,:), & 108 111 & id_rho(:), ld_even(:)) 109 112 110 ALLOCATE( dl_weight_I( 4,((id_rho(jp_I)+1) )) )111 ALLOCATE( dl_weight_J( 4,( (id_rho(jp_J)+1))) )113 ALLOCATE( dl_weight_I( 2,((id_rho(jp_I)+1) )) ) 114 ALLOCATE( dl_weight_J( 2,( (id_rho(jp_J)+1))) ) 112 115 CALL interp_linear__get_weight1D(dl_weight_I(:,:), & 113 116 & id_rho(jp_I), ld_even(jp_I)) … … 115 118 & id_rho(jp_J), ld_even(jp_J)) 116 119 120 ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3))) 121 117 122 DO jl=1,il_shape(4) 123 il_detect(:,:,:)=id_detect(:,:,:) 118 124 ! loop on vertical level 119 125 DO jk=1,il_shape(3) … … 121 127 ! I-J plan 122 128 CALL interp_linear__2D(dd_value(:,:,jk,jl), dd_fill,& 123 & i d_detect(:,:,jk), &129 & il_detect(:,:,jk), & 124 130 & dl_weight_IJ(:,:), & 125 131 & id_rho(jp_I), id_rho(jp_J), & 126 132 & ll_discont) 127 IF( ANY(i d_detect(:,:,jk)==1) )THEN133 IF( ANY(il_detect(:,:,jk)==1) )THEN 128 134 ! I direction 129 135 DO jj=1,il_shape(2) 130 136 CALL interp_linear__1D( dd_value(:,jj,jk,jl), dd_fill,& 131 & i d_detect(:,jj,jk), &137 & il_detect(:,jj,jk), & 132 138 & dl_weight_I(:,:), & 133 139 & id_rho(jp_I), ll_discont ) 134 140 ENDDO 135 IF( ALL(i d_detect(:,:,jk)==0) )THEN141 IF( ALL(il_detect(:,:,jk)==0) )THEN 136 142 CYCLE 137 143 ELSE … … 139 145 DO ji=1,il_shape(1) 140 146 CALL interp_linear__1D( dd_value(ji,:,jk,jl), dd_fill,& 141 & i d_detect(ji,:,jk), &147 & il_detect(ji,:,jk), & 142 148 & dl_weight_J(:,:), & 143 149 & id_rho(jp_J), ll_discont ) … … 149 155 ENDDO 150 156 157 id_detect(:,:,:)=il_detect(:,:,:) 158 DEALLOCATE(il_detect) 159 151 160 DEALLOCATE(dl_weight_IJ) 152 161 DEALLOCATE(dl_weight_I) 153 162 DEALLOCATE(dl_weight_J) 154 163 155 164 END SUBROUTINE interp_linear_fill 156 165 !------------------------------------------------------------------- … … 161 170 !> 162 171 !> @author J.Paul 163 !> - September, 2014- Initial Version172 !> @date September, 2014 - Initial Version 164 173 !> 165 174 !> @param[inout] dd_value 2D array of variable value … … 235 244 IF( ALL(id_detect(ji:ji+id_rhoi, & 236 245 & jj:jj+id_rhoj)==0) ) CYCLE 237 ! check data toneeded to interpolate246 ! check data needed to interpolate 238 247 IF( ANY(dl_coarse(ii:ii+1,ij:ij+1)==dd_fill) ) CYCLE 239 248 ! check longitude discontinuity … … 296 305 !> 297 306 !> @author J.Paul 298 !> - September, 2014- Initial Version307 !> @date September, 2014 - Initial Version 299 308 !> 300 309 !> @param[inout] dd_value 1D array of variable value … … 408 417 !> 409 418 !> @author J.Paul 410 !> - September, 2014- Initial Version419 !> @date September, 2014 - Initial Version 411 420 !> 412 421 !> @param[in] dd_value 2D array of value … … 445 454 !> 446 455 !> @author J.Paul 447 !> - September, 2014- Initial Version448 !> 456 !> @date September, 2014 - Initial Version 457 !> 449 458 !> @param[inout] dd_value 2D array of mixed grid value 450 459 !> @param[inout] id_detect 2D array of point to be interpolated … … 477 486 !---------------------------------------------------------------- 478 487 479 IF( ANY( dd_coef(:)==dd_fill ) )THEN 480 CALL logger_error("INTERP LINEAR FILL: fill value detected in coef. "//& 481 & "can not compute interpolation.") 482 ELSE 483 484 ii=0 485 DO jj=1,id_rhoj+1 486 DO ji=1,id_rhoi+1 487 488 ii=ii+1 489 IF(id_detect(ji,jj)==1)THEN 490 491 dd_value(ji,jj)=DOT_PRODUCT(dd_coef(:),dd_weight(:,ii)) 492 id_detect(ji,jj)=0 493 494 ENDIF 495 496 ENDDO 488 IF( ANY( dd_coef(:)==dd_fill ) )THEN 489 CALL logger_error("INTERP LINEAR FILL: fill value detected in coef. "//& 490 & "can not compute interpolation.") 491 ELSE 492 493 ii=0 494 DO jj=1,id_rhoj+1 495 DO ji=1,id_rhoi+1 496 497 ii=ii+1 498 IF(id_detect(ji,jj)==1)THEN 499 500 dd_value(ji,jj)=DOT_PRODUCT(dd_coef(:),dd_weight(:,ii)) 501 id_detect(ji,jj)=0 502 503 ENDIF 504 497 505 ENDDO 498 499 ENDIF 506 ENDDO 507 508 ENDIF 500 509 501 510 END SUBROUTINE interp_linear__2D_fill … … 505 514 !> 506 515 !> @author J.Paul 507 !> - September, 2014- Initial Version516 !> @date September, 2014 - Initial Version 508 517 !> 509 518 !> @param[in] dd_value 1D array of value … … 540 549 !> 541 550 !> @author J.Paul 542 !> - September, 2014- Initial Version551 !> @date September, 2014 - Initial Version 543 552 !> 544 553 !> @param[inout] dd_value 1D array of mixed grid value … … 591 600 !> 592 601 !> @author J.Paul 593 !> - September, 2014- Initial Version602 !> @date September, 2014 - Initial Version 594 603 !> 595 604 !> @param[in] dd_weight interpolation weight of 2D array … … 660 669 !> 661 670 !> @author J.Paul 662 !> - September, 2014- Initial Version671 !> @date September, 2014 - Initial Version 663 672 !> 664 673 !> @param[in] dd_weight interpolation weight of 1D array
Note: See TracChangeset
for help on using the changeset viewer.