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 12080 for utils/tools/SIREN/src/interp_linear.f90 – NEMO

Ignore:
Timestamp:
2019-12-06T10:30:14+01:00 (4 years ago)
Author:
jpaul
Message:

update nemo trunk

File:
1 edited

Legend:

Unmodified
Added
Removed

  • utils/tools/SIREN/src/interp_linear.f90

    r9598 r12080  
    22! NEMO system team, System and Interface for oceanic RElocable Nesting 
    33!---------------------------------------------------------------------- 
    4 ! 
    5 ! MODULE: interp 
    64! 
    75! DESCRIPTION: 
    … …  
    2321!> @author 
    2422!> J.Paul 
    25 ! REVISION HISTORY: 
     23!> 
    2624!> @date September, 2014 - Initial version 
    2725!> 
    28 !> @note Software governed by the CeCILL licence     (./LICENSE) 
     26!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    2927!---------------------------------------------------------------------- 
    30  
    3128MODULE interp_linear 
    3229 
    … …  
    5552   PRIVATE :: interp_linear__get_weight1D !< compute interpoaltion weight for 1D array. 
    5653 
    57 CONTAINS    
     54CONTAINS 
     55   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     56   SUBROUTINE interp_linear_fill(dd_value, dd_fill, id_detect, & 
     57         &                       id_rho, ld_even, ld_discont) 
    5858   !------------------------------------------------------------------- 
    5959   !> @brief 
    … …  
    7373   !> @param[in] ld_discont   longitudinal discontinuity (-180°/180°, 0°/360°) or not 
    7474   !------------------------------------------------------------------- 
    75    SUBROUTINE interp_linear_fill(dd_value, dd_fill, id_detect, & 
    76    &                             id_rho, ld_even, ld_discont ) 
    77       IMPLICIT NONE 
     75 
     76      IMPLICIT NONE 
     77 
    7878      ! Argument 
    7979      REAL(dp)        , DIMENSION(:,:,:,:), INTENT(INOUT) :: dd_value  
    … …  
    163163  
    164164   END SUBROUTINE interp_linear_fill 
     165   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     166   SUBROUTINE interp_linear__2D(dd_value,  dd_fill,   & 
     167         &                      id_detect,            & 
     168         &                      dd_weight,            & 
     169         &                      id_rhoi, id_rhoj,     & 
     170         &                      ld_discont) 
    165171   !------------------------------------------------------------------- 
    166172   !> @brief 
    … …  
    181187   !> @param[in] ld_discont   longitudinal discontinuity (-180°/180°, 0°/360°) or not 
    182188   !------------------------------------------------------------------- 
    183    SUBROUTINE interp_linear__2D( dd_value,  dd_fill,   & 
    184       &                          id_detect,            & 
    185       &                          dd_weight,            & 
    186       &                          id_rhoi, id_rhoj,     & 
    187       &                          ld_discont ) 
    188  
    189       IMPLICIT NONE 
     189 
     190      IMPLICIT NONE 
     191 
    190192      ! Argument 
    191193      REAL(dp)        , DIMENSION(:,:), INTENT(INOUT) :: dd_value  
    … …  
    298300 
    299301   END SUBROUTINE interp_linear__2D 
     302   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     303   SUBROUTINE interp_linear__1D(dd_value,  dd_fill,   & 
     304         &                      id_detect,            & 
     305         &                      dd_weight,            & 
     306         &                      id_rhoi,              & 
     307         &                      ld_discont) 
    300308   !------------------------------------------------------------------- 
    301309   !> @brief 
    … …  
    314322   !> @param[in] ld_discont   longitudinal discontinuity (-180°/180°, 0°/360°) or not 
    315323   !------------------------------------------------------------------- 
    316    SUBROUTINE interp_linear__1D( dd_value,  dd_fill,   & 
    317       &                          id_detect,            & 
    318       &                          dd_weight,            & 
    319       &                          id_rhoi,              & 
    320       &                          ld_discont ) 
    321  
    322       IMPLICIT NONE 
     324 
     325      IMPLICIT NONE 
     326 
    323327      ! Argument 
    324328      REAL(dp)        , DIMENSION(:)  , INTENT(INOUT) :: dd_value  
    … …  
    412416 
    413417   END SUBROUTINE interp_linear__1D 
     418   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     419   FUNCTION interp_linear__2D_coef(dd_value, dd_fill) & 
     420         & RESULT (df_coef) 
    414421   !------------------------------------------------------------------- 
    415422   !> @brief 
    … …  
    422429   !> @param[in] dd_fill   FillValue of variable 
    423430   !------------------------------------------------------------------- 
    424    FUNCTION interp_linear__2D_coef( dd_value, dd_fill ) 
    425       IMPLICIT NONE 
     431 
     432      IMPLICIT NONE 
     433 
    426434      ! Argument 
    427435      REAL(dp), DIMENSION(:,:)  , INTENT(IN) :: dd_value  
    … …  
    429437 
    430438      ! function 
    431       REAL(dp), DIMENSION(4) :: interp_linear__2D_coef 
     439      REAL(dp), DIMENSION(4)                 :: df_coef 
    432440 
    433441      ! local variable 
    … …  
    443451      !---------------------------------------------------------------- 
    444452      ! init 
    445       interp_linear__2D_coef(:)=dd_fill 
     453      df_coef(:)=dd_fill 
    446454 
    447455      dl_vect( 1: 4)=PACK(dd_value(:,:),.TRUE. ) 
    448       interp_linear__2D_coef(:)=MATMUL(dl_matrix(:,:),dl_vect(:)) 
     456      df_coef(:)=MATMUL(dl_matrix(:,:),dl_vect(:)) 
    449457 
    450458   END FUNCTION interp_linear__2D_coef 
     459   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     460   SUBROUTINE interp_linear__2D_fill(dd_value, id_detect, & 
     461         &                           dd_weight, dd_coef,  & 
     462         &                           dd_fill, id_rhoi, id_rhoj) 
    451463   !------------------------------------------------------------------- 
    452464   !> @brief 
    … …  
    464476   !> @param[in] id_rhoj      refinement factor in j-direction 
    465477   !------------------------------------------------------------------- 
    466    SUBROUTINE interp_linear__2D_fill( dd_value, id_detect, & 
    467    &                                  dd_weight, dd_coef,  & 
    468    &                                  dd_fill, id_rhoi, id_rhoj ) 
    469       IMPLICIT NONE 
     478 
     479      IMPLICIT NONE 
     480 
    470481      ! Argument 
    471482      REAL(dp)        , DIMENSION(:,:), INTENT(INOUT) :: dd_value  
    … …  
    509520 
    510521   END SUBROUTINE interp_linear__2D_fill 
     522   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     523   FUNCTION interp_linear__1D_coef(dd_value, dd_fill) & 
     524         & RESULT (df_coef) 
    511525   !------------------------------------------------------------------- 
    512526   !> @brief 
    … …  
    519533   !> @param[in] dd_fill   FillValue of variable 
    520534   !------------------------------------------------------------------- 
    521    FUNCTION interp_linear__1D_coef( dd_value, dd_fill ) 
    522       IMPLICIT NONE 
     535 
     536      IMPLICIT NONE 
     537 
    523538      ! Argument 
    524539      REAL(dp), DIMENSION(:)  , INTENT(IN) :: dd_value  
    … …  
    526541 
    527542      ! function 
    528       REAL(dp), DIMENSION(2) :: interp_linear__1D_coef 
     543      REAL(dp), DIMENSION(2)               :: df_coef 
    529544 
    530545      ! local variable 
    … …  
    538553      !---------------------------------------------------------------- 
    539554      ! init 
    540       interp_linear__1D_coef(:)=dd_fill 
     555      df_coef(:)=dd_fill 
    541556 
    542557      dl_vect( 1: 2)=PACK(dd_value(:),.TRUE. ) 
    543       interp_linear__1D_coef(:)=MATMUL(dl_matrix(:,:),dl_vect(:)) 
     558      df_coef(:)=MATMUL(dl_matrix(:,:),dl_vect(:)) 
    544559 
    545560   END FUNCTION interp_linear__1D_coef 
     561   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     562   SUBROUTINE interp_linear__1D_fill(dd_value, id_detect, & 
     563         &                           dd_weight, dd_coef,  & 
     564         &                           dd_fill, id_rho) 
    546565   !------------------------------------------------------------------- 
    547566   !> @brief 
    … …  
    558577   !> @param[in] id_rho       refinement factor 
    559578   !------------------------------------------------------------------- 
    560    SUBROUTINE interp_linear__1D_fill( dd_value, id_detect, & 
    561    &                                  dd_weight, dd_coef,  & 
    562    &                                  dd_fill, id_rho ) 
    563       IMPLICIT NONE 
     579 
     580      IMPLICIT NONE 
     581 
    564582      ! Argument 
    565583      REAL(dp)        , DIMENSION(:)  , INTENT(INOUT) :: dd_value  
    … …  
    595613 
    596614   END SUBROUTINE interp_linear__1D_fill 
     615   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     616   SUBROUTINE interp_linear__get_weight2D(dd_weight, id_rho, ld_even) 
    597617   !------------------------------------------------------------------- 
    598618   !> @brief 
    … …  
    606626   !> @param[in] id_rho    refinement factor  
    607627   !------------------------------------------------------------------- 
    608    SUBROUTINE interp_linear__get_weight2D(dd_weight, & 
    609    &                                     id_rho, ld_even) 
    610       IMPLICIT NONE 
    611       ! Argument 
     628 
     629      IMPLICIT NONE 
     630 
     631      ! Argument 
     632 
    612633      REAL(dp)   , DIMENSION(:,:), INTENT(INOUT) :: dd_weight 
    613634      INTEGER(I4), DIMENSION(:)  , INTENT(IN   ) :: id_rho 
    614635      LOGICAL    , DIMENSION(:)  , INTENT(IN   ) :: ld_even 
     636 
    615637      ! local variable 
    616638      REAL(dp)                  :: dl_dx 
    … …  
    664686 
    665687   END SUBROUTINE interp_linear__get_weight2D 
     688   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     689   SUBROUTINE interp_linear__get_weight1D(dd_weight, id_rho, ld_even) 
    666690   !------------------------------------------------------------------- 
    667691   !> @brief 
    … …  
    675699   !> @param[in] id_rho    refinement factor  
    676700   !------------------------------------------------------------------- 
    677    SUBROUTINE interp_linear__get_weight1D(dd_weight, & 
    678    &                                     id_rho, ld_even) 
    679       IMPLICIT NONE 
     701 
     702      IMPLICIT NONE 
     703 
    680704      ! Argument 
    681705      REAL(dp)   , DIMENSION(:,:), INTENT(INOUT) :: dd_weight 
    … …  
    708732 
    709733   END SUBROUTINE interp_linear__get_weight1D 
     734   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    710735END MODULE interp_linear 
Note: See TracChangeset for help on using the changeset viewer.