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 10251 for branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90 – NEMO

Ignore:
Timestamp:
2018-10-29T15:20:26+01:00 (5 years ago)
Author:
kingr
Message:

Rolled back to r10247 - i.e., undid merge of pkg br and 3.6_stable br

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90

    r10248 r10251  
    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    !> @date September, 2014 - Initial Version 
    66    !> @date July, 2015 - reinitialise detect array for each level 
     65   !> - September, 2014- Initial Version 
    6766   !> 
    6867   !> @param[inout] dd_value  2D array of variable value  
    … …  
    8584 
    8685      ! local variable 
    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 
     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 
    9693       
    9794      ! loop indices 
    … …  
    107104 
    108105      ! compute vect2D 
    109       ALLOCATE(dl_weight_IJ(4,((id_rho(jp_I)+1)*(id_rho(jp_J)+1))) ) 
     106      ALLOCATE(dl_weight_IJ(16,((id_rho(jp_I)+1)*(id_rho(jp_J)+1))) ) 
    110107      CALL interp_linear__get_weight2D(dl_weight_IJ(:,:), & 
    111108      &                               id_rho(:), ld_even(:)) 
    112109 
    113       ALLOCATE( dl_weight_I( 2,((id_rho(jp_I)+1)                 )) ) 
    114       ALLOCATE( dl_weight_J( 2,(                 (id_rho(jp_J)+1))) ) 
     110      ALLOCATE( dl_weight_I( 4,((id_rho(jp_I)+1)                 )) ) 
     111      ALLOCATE( dl_weight_J( 4,(                 (id_rho(jp_J)+1))) ) 
    115112      CALL interp_linear__get_weight1D(dl_weight_I(:,:), & 
    116113      &                               id_rho(jp_I), ld_even(jp_I)) 
    … …  
    118115      &                               id_rho(jp_J), ld_even(jp_J)) 
    119116 
    120       ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3))) 
    121  
    122117      DO jl=1,il_shape(4) 
    123          il_detect(:,:,:)=id_detect(:,:,:) 
    124118         ! loop on vertical level 
    125119         DO jk=1,il_shape(3) 
    … …  
    127121            ! I-J plan 
    128122            CALL interp_linear__2D(dd_value(:,:,jk,jl), dd_fill,& 
    129             &                     il_detect(:,:,jk),            & 
     123            &                     id_detect(:,:,jk),            & 
    130124            &                     dl_weight_IJ(:,:),            & 
    131125            &                     id_rho(jp_I), id_rho(jp_J),   & 
    132126            &                     ll_discont)             
    133             IF( ANY(il_detect(:,:,jk)==1) )THEN 
     127            IF( ANY(id_detect(:,:,jk)==1) )THEN 
    134128               ! I direction 
    135129               DO jj=1,il_shape(2) 
    136130                  CALL interp_linear__1D( dd_value(:,jj,jk,jl), dd_fill,& 
    137                   &                       il_detect(:,jj,jk),           & 
     131                  &                       id_detect(:,jj,jk),           & 
    138132                  &                       dl_weight_I(:,:),             & 
    139133                  &                       id_rho(jp_I), ll_discont ) 
    140134               ENDDO 
    141                IF( ALL(il_detect(:,:,jk)==0) )THEN 
     135               IF( ALL(id_detect(:,:,jk)==0) )THEN 
    142136                  CYCLE 
    143137               ELSE 
    … …  
    145139                  DO ji=1,il_shape(1) 
    146140                     CALL interp_linear__1D( dd_value(ji,:,jk,jl), dd_fill,& 
    147                      &                       il_detect(ji,:,jk),           & 
     141                     &                       id_detect(ji,:,jk),           & 
    148142                     &                       dl_weight_J(:,:),             & 
    149143                     &                       id_rho(jp_J), ll_discont ) 
    … …  
    155149      ENDDO 
    156150 
    157       id_detect(:,:,:)=il_detect(:,:,:) 
    158       DEALLOCATE(il_detect) 
    159  
    160151      DEALLOCATE(dl_weight_IJ) 
    161152      DEALLOCATE(dl_weight_I) 
    162153      DEALLOCATE(dl_weight_J) 
    163   
     154       
    164155   END SUBROUTINE interp_linear_fill 
    165156   !------------------------------------------------------------------- 
    … …  
    170161   !> 
    171162   !> @author J.Paul 
    172    !> @date September, 2014 - Initial Version 
     163   !> - September, 2014- Initial Version 
    173164   !> 
    174165   !> @param[inout] dd_value  2D array of variable value  
    … …  
    244235               IF( ALL(id_detect(ji:ji+id_rhoi,   & 
    245236               &                 jj:jj+id_rhoj)==0) ) CYCLE 
    246                ! check data needed to interpolate 
     237               ! check data to needed to interpolate 
    247238               IF( ANY(dl_coarse(ii:ii+1,ij:ij+1)==dd_fill) ) CYCLE 
    248239               ! check longitude discontinuity 
    … …  
    305296   !> 
    306297   !> @author J.Paul 
    307    !> @date September, 2014 - Initial Version 
     298   !> - September, 2014- Initial Version 
    308299   !> 
    309300   !> @param[inout] dd_value  1D array of variable value  
    … …  
    417408   !>  
    418409   !> @author J.Paul 
    419    !> @date September, 2014 - Initial Version 
     410   !> - September, 2014- Initial Version 
    420411   !> 
    421412   !> @param[in] dd_value  2D array of value 
    … …  
    454445   !>  
    455446   !> @author J.Paul 
    456    !> @date September, 2014 - Initial Version 
    457    !> 
     447   !> - September, 2014- Initial Version 
     448   !>  
    458449   !> @param[inout] dd_value  2D array of mixed grid value 
    459450   !> @param[inout] id_detect 2D array of point to be interpolated 
    … …  
    486477      !---------------------------------------------------------------- 
    487478 
    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  
     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 
    505497            ENDDO 
    506          ENDDO 
    507  
    508       ENDIF 
     498 
     499         ENDIF 
    509500 
    510501   END SUBROUTINE interp_linear__2D_fill 
    … …  
    514505   !>  
    515506   !> @author J.Paul 
    516    !> @date September, 2014 - Initial Version 
     507   !> - September, 2014- Initial Version 
    517508   !> 
    518509   !> @param[in] dd_value  1D array of value 
    … …  
    549540   !>  
    550541   !> @author J.Paul 
    551    !> @date September, 2014 - Initial Version 
     542   !> - September, 2014- Initial Version 
    552543   !>  
    553544   !> @param[inout] dd_value  1D array of mixed grid value 
    … …  
    600591   !>  
    601592   !> @author J.Paul 
    602    !> @date September, 2014 - Initial Version 
     593   !> - September, 2014- Initial Version 
    603594   !> 
    604595   !> @param[in] dd_weight interpolation weight of 2D array 
    … …  
    669660   !>  
    670661   !> @author J.Paul 
    671    !> @date September, 2014 - Initial Version 
     662   !> - September, 2014- Initial Version 
    672663   !> 
    673664   !> @param[in] dd_weight interpolation weight of 1D array 
Note: See TracChangeset for help on using the changeset viewer.