New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 5951 for branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90 – NEMO

Ignore:
Timestamp:
2015-11-30T12:48:01+01:00 (8 years ago)
Author:
timgraham
Message:

Merged trunk r5936 into branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90

    r5950 r5951  
    2424!> J.Paul 
    2525! REVISION HISTORY: 
    26 !> @date September, 2014 -Initial version 
     26!> @date September, 2014 - Initial version 
    2727!> 
    2828!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    6363   !> 
    6464   !> @author J.Paul 
    65    !> - September, 2014- Initial Version 
     65   !> @date September, 2014 - Initial Version 
     66   !> @date July, 2015 - reinitialise detect array for each level 
    6667   !> 
    6768   !> @param[inout] dd_value  2D array of variable value  
     
    8485 
    8586      ! 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 
    9396       
    9497      ! loop indices 
     
    104107 
    105108      ! 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))) ) 
    107110      CALL interp_linear__get_weight2D(dl_weight_IJ(:,:), & 
    108111      &                               id_rho(:), ld_even(:)) 
    109112 
    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))) ) 
    112115      CALL interp_linear__get_weight1D(dl_weight_I(:,:), & 
    113116      &                               id_rho(jp_I), ld_even(jp_I)) 
     
    115118      &                               id_rho(jp_J), ld_even(jp_J)) 
    116119 
     120      ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3))) 
     121 
    117122      DO jl=1,il_shape(4) 
     123         il_detect(:,:,:)=id_detect(:,:,:) 
    118124         ! loop on vertical level 
    119125         DO jk=1,il_shape(3) 
     
    121127            ! I-J plan 
    122128            CALL interp_linear__2D(dd_value(:,:,jk,jl), dd_fill,& 
    123             &                     id_detect(:,:,jk),            & 
     129            &                     il_detect(:,:,jk),            & 
    124130            &                     dl_weight_IJ(:,:),            & 
    125131            &                     id_rho(jp_I), id_rho(jp_J),   & 
    126132            &                     ll_discont)             
    127             IF( ANY(id_detect(:,:,jk)==1) )THEN 
     133            IF( ANY(il_detect(:,:,jk)==1) )THEN 
    128134               ! I direction 
    129135               DO jj=1,il_shape(2) 
    130136                  CALL interp_linear__1D( dd_value(:,jj,jk,jl), dd_fill,& 
    131                   &                       id_detect(:,jj,jk),           & 
     137                  &                       il_detect(:,jj,jk),           & 
    132138                  &                       dl_weight_I(:,:),             & 
    133139                  &                       id_rho(jp_I), ll_discont ) 
    134140               ENDDO 
    135                IF( ALL(id_detect(:,:,jk)==0) )THEN 
     141               IF( ALL(il_detect(:,:,jk)==0) )THEN 
    136142                  CYCLE 
    137143               ELSE 
     
    139145                  DO ji=1,il_shape(1) 
    140146                     CALL interp_linear__1D( dd_value(ji,:,jk,jl), dd_fill,& 
    141                      &                       id_detect(ji,:,jk),           & 
     147                     &                       il_detect(ji,:,jk),           & 
    142148                     &                       dl_weight_J(:,:),             & 
    143149                     &                       id_rho(jp_J), ll_discont ) 
     
    149155      ENDDO 
    150156 
     157      id_detect(:,:,:)=il_detect(:,:,:) 
     158      DEALLOCATE(il_detect) 
     159 
    151160      DEALLOCATE(dl_weight_IJ) 
    152161      DEALLOCATE(dl_weight_I) 
    153162      DEALLOCATE(dl_weight_J) 
    154        
     163  
    155164   END SUBROUTINE interp_linear_fill 
    156165   !------------------------------------------------------------------- 
     
    161170   !> 
    162171   !> @author J.Paul 
    163    !> - September, 2014- Initial Version 
     172   !> @date September, 2014 - Initial Version 
    164173   !> 
    165174   !> @param[inout] dd_value  2D array of variable value  
     
    235244               IF( ALL(id_detect(ji:ji+id_rhoi,   & 
    236245               &                 jj:jj+id_rhoj)==0) ) CYCLE 
    237                ! check data to needed to interpolate 
     246               ! check data needed to interpolate 
    238247               IF( ANY(dl_coarse(ii:ii+1,ij:ij+1)==dd_fill) ) CYCLE 
    239248               ! check longitude discontinuity 
     
    296305   !> 
    297306   !> @author J.Paul 
    298    !> - September, 2014- Initial Version 
     307   !> @date September, 2014 - Initial Version 
    299308   !> 
    300309   !> @param[inout] dd_value  1D array of variable value  
     
    408417   !>  
    409418   !> @author J.Paul 
    410    !> - September, 2014- Initial Version 
     419   !> @date September, 2014 - Initial Version 
    411420   !> 
    412421   !> @param[in] dd_value  2D array of value 
     
    445454   !>  
    446455   !> @author J.Paul 
    447    !> - September, 2014- Initial Version 
    448    !>  
     456   !> @date September, 2014 - Initial Version 
     457   !> 
    449458   !> @param[inout] dd_value  2D array of mixed grid value 
    450459   !> @param[inout] id_detect 2D array of point to be interpolated 
     
    477486      !---------------------------------------------------------------- 
    478487 
    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 
    497505            ENDDO 
    498  
    499          ENDIF 
     506         ENDDO 
     507 
     508      ENDIF 
    500509 
    501510   END SUBROUTINE interp_linear__2D_fill 
     
    505514   !>  
    506515   !> @author J.Paul 
    507    !> - September, 2014- Initial Version 
     516   !> @date September, 2014 - Initial Version 
    508517   !> 
    509518   !> @param[in] dd_value  1D array of value 
     
    540549   !>  
    541550   !> @author J.Paul 
    542    !> - September, 2014- Initial Version 
     551   !> @date September, 2014 - Initial Version 
    543552   !>  
    544553   !> @param[inout] dd_value  1D array of mixed grid value 
     
    591600   !>  
    592601   !> @author J.Paul 
    593    !> - September, 2014- Initial Version 
     602   !> @date September, 2014 - Initial Version 
    594603   !> 
    595604   !> @param[in] dd_weight interpolation weight of 2D array 
     
    660669   !>  
    661670   !> @author J.Paul 
    662    !> - September, 2014- Initial Version 
     671   !> @date September, 2014 - Initial Version 
    663672   !> 
    664673   !> @param[in] dd_weight interpolation weight of 1D array 
Note: See TracChangeset for help on using the changeset viewer.