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 6808 for branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/interp_cubic.f90 – NEMO

Ignore:
Timestamp:
2016-07-19T10:38:35+02:00 (8 years ago)
Author:
jamesharle
Message:

merge with trunk@6232 for consistency with SSB code

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/interp_cubic.f90

    r5037 r6808  
    2626! REVISION HISTORY: 
    2727!> @date September, 2014 -Initial version 
     28!> @date June, 2015 
     29!> - use math module 
    2830!> 
    2931!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    3638   USE logger                          ! log file manager 
    3739   USE fct                             ! basic useful function 
    38    USE extrap                          ! extrapolation manager 
     40   USE math                            ! mathematical function 
    3941 
    4042   IMPLICIT NONE 
     
    6163   !>  
    6264   !> @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 
    6468   !> 
    6569   !> @param[inout] dd_value  2D array of variable value  
     
    8286 
    8387      ! 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 
    9197       
    9298      ! loop indices 
     
    113119      &                               id_rho(jp_J), ld_even(jp_J)) 
    114120 
     121      ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3))) 
     122 
    115123      DO jl=1,il_shape(4) 
     124         il_detect(:,:,:)=id_detect(:,:,:) 
    116125         ! loop on vertical level 
    117126         DO jk=1,il_shape(3) 
     
    119128            ! I-J plan 
    120129            CALL interp_cubic__2D(dd_value(:,:,jk,jl), dd_fill, & 
    121             &                     id_detect(:,:,jk),            & 
     130            &                     il_detect(:,:,jk),            & 
    122131            &                     dl_weight_IJ(:,:),            & 
    123132            &                     id_rho(jp_I), id_rho(jp_J),   & 
    124133            &                     ll_discont)             
    125             IF( ANY(id_detect(:,:,jk)==1) )THEN 
     134            IF( ANY(il_detect(:,:,jk)==1) )THEN 
    126135               ! I direction 
    127136               DO jj=1,il_shape(2) 
    128137                  CALL interp_cubic__1D( dd_value(:,jj,jk,jl), dd_fill, & 
    129                   &                      id_detect(:,jj,jk),            & 
     138                  &                      il_detect(:,jj,jk),            & 
    130139                  &                      dl_weight_I(:,:),              & 
    131140                  &                      id_rho(jp_I), ll_discont ) 
    132141               ENDDO 
    133                IF( ALL(id_detect(:,:,jk)==0) )THEN 
     142               IF( ALL(il_detect(:,:,jk)==0) )THEN 
    134143                  CYCLE 
    135144               ELSE 
     
    137146                  DO ji=1,il_shape(1) 
    138147                     CALL interp_cubic__1D( dd_value(ji,:,jk,jl), dd_fill, & 
    139                      &                      id_detect(ji,:,jk),            & 
     148                     &                      il_detect(ji,:,jk),            & 
    140149                     &                      dl_weight_J(:,:),              & 
    141150                     &                      id_rho(jp_J), ll_discont ) 
     
    147156      ENDDO 
    148157 
     158      id_detect(:,:,:)=il_detect(:,:,:) 
     159      DEALLOCATE(il_detect) 
     160 
    149161      DEALLOCATE(dl_weight_IJ) 
    150162      DEALLOCATE(dl_weight_I) 
     
    159171   !> 
    160172   !> @author J.Paul 
    161    !> - September, 2014- Initial Version 
     173   !> @date September, 2014 - Initial Version 
    162174   !> 
    163175   !> @param[inout] dd_value  2D array of variable value  
     
    181193      REAL(dp)                        , INTENT(IN   ) :: dd_fill  
    182194      INTEGER(I4)     , DIMENSION(:,:), INTENT(INOUT) :: id_detect 
    183       REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight  
     195      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight 
    184196      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoi 
    185197      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoj 
     
    230242 
    231243         ! 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) 
    234246 
    235247         ! 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) 
    237249 
    238250         ALLOCATE( dl_tmp(2,2) ) 
     
    319331   !> 
    320332   !> @author J.Paul 
    321    !> - September, 2014- Initial Version 
     333   !> @date September, 2014 - Initial Version 
    322334   !> 
    323335   !> @param[inout] dd_value  1D array of variable value  
     
    339351      REAL(dp)                        , INTENT(IN   ) :: dd_fill  
    340352      INTEGER(I4)     , DIMENSION(:)  , INTENT(INOUT) :: id_detect 
    341       REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight  
     353      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight 
    342354      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoi 
    343355      LOGICAL                         , INTENT(IN   ) :: ld_discont 
     
    376388 
    377389         ! 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) 
    379391 
    380392         ALLOCATE( dl_tmp(2) ) 
     
    440452   !>  
    441453   !> @author J.Paul 
    442    !> - September, 2014- Initial Version 
     454   !> @date September, 2014 - Initial Version 
    443455   !> 
    444456   !> @param[in] dd_value  2D array of value 
     
    503515   !>  
    504516   !> @author J.Paul 
    505    !> - September, 2014- Initial Version 
     517   !> @date September, 2014 - Initial Version 
    506518   !> 
    507519   !> @param[inout] dd_value  2D array of mixed grid value 
     
    565577   !> 
    566578   !> @author J.Paul 
    567    !> - September, 2014- Initial Version 
     579   !> @date September, 2014 - Initial Version 
    568580   !> 
    569581   !> @param[in] dd_value  1D array of value 
     
    608620   !>  
    609621   !> @author J.Paul 
    610    !> - September, 2014- Initial Version 
     622   !> @date September, 2014 - Initial Version 
    611623   !> 
    612624   !> @param[inout] dd_value  1D array of mixed grid value 
     
    659671   !>  
    660672   !> @author J.Paul 
    661    !> - September, 2014- Initial Version 
     673   !> @date September, 2014 - Initial Version 
    662674   !> 
    663675   !> @param[in] dd_weight interpolation weight of 2D array 
     
    740752   !>  
    741753   !> @author J.Paul 
    742    !> - September, 2014- Initial Version 
     754   !> @date September, 2014 - Initial Version 
    743755   !> 
    744756   !> @param[in] dd_weight interpolation weight of 1D array 
Note: See TracChangeset for help on using the changeset viewer.