Changeset 5747


Ignore:
Timestamp:
Jul 1, 2025, 5:54:33 PM (2 days ago)
Author:
dcugnet
Message:

Add the "duplicate" function.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • LMDZ6/trunk/libf/misc/strings_mod.f90

    r5746 r5747  
    66  PUBLIC :: maxlen, init_printout, msg, get_in, lunout, prt_level
    77  PUBLIC :: strLower, strHead, strStack,  strCount, strReduce,  strClean, strIdx
    8   PUBLIC :: strUpper, strTail, strStackm, strParse, strReplace, strFind, find, cat
     8  PUBLIC :: strUpper, strTail, strStackm, strParse, strReplace, strFind, find, duplicate, cat
    99  PUBLIC :: dispTable, dispOutliers, dispNameList
    1010  PUBLIC :: is_numeric, bool2str, int2str, real2str, dble2str
     
    2727  INTERFACE strFind;      MODULE PROCEDURE strFind_1, strFind_m;                 END INTERFACE strFind
    2828  INTERFACE find;         MODULE PROCEDURE strFind_1, strFind_m, intFind_1, intFind_m, booFind; END INTERFACE find
     29  INTERFACE duplicate;    MODULE PROCEDURE dupl_s, dupl_i, dupl_r, dupl_l; END INTERFACE duplicate
    2930  INTERFACE dispOutliers; MODULE PROCEDURE dispOutliers_1, dispOutliers_2; END INTERFACE dispOutliers
    3031  INTERFACE reduceExpr;   MODULE PROCEDURE   reduceExpr_1,   reduceExpr_m; END INTERFACE reduceExpr
     
    449450  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
    450451END FUNCTION booFind
     452!==============================================================================================================================
     453
     454
     455!==============================================================================================================================
     456!=== DUPLICATE A VECTOR "v(:)" "n" times ======================================================================================
     457!==============================================================================================================================
     458SUBROUTINE dupl_s(v, n, vdup)
     459  CHARACTER(LEN=*),                   INTENT(IN)  :: v(:)
     460  INTEGER,                            INTENT(IN)  :: n
     461  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: vdup(:)
     462!------------------------------------------------------------------------------------------------------------------------------
     463  INTEGER :: nv, i
     464  nv = SIZE(v)
     465  ALLOCATE(vdup(n*nv))
     466  DO i = 1, n; vdup(1+(i-1)*nv:i*nv) = v; END DO
     467END SUBROUTINE dupl_s
     468!==============================================================================================================================
     469SUBROUTINE dupl_i(v, n, vdup)
     470  INTEGER,              INTENT(IN)  :: v(:)
     471  INTEGER,              INTENT(IN)  :: n
     472  INTEGER, ALLOCATABLE, INTENT(OUT) :: vdup(:)
     473!------------------------------------------------------------------------------------------------------------------------------
     474  INTEGER :: nv, i
     475  nv = SIZE(v)
     476  ALLOCATE(vdup(n*nv))
     477  DO i = 1, n; vdup(1+(i-1)*nv:i*nv) = v; END DO
     478END SUBROUTINE dupl_i
     479!==============================================================================================================================
     480SUBROUTINE dupl_r(v, n, vdup)
     481  REAL,                 INTENT(IN)  :: v(:)
     482  INTEGER,              INTENT(IN)  :: n
     483  REAL,    ALLOCATABLE, INTENT(OUT) :: vdup(:)
     484!------------------------------------------------------------------------------------------------------------------------------
     485  INTEGER :: nv, i
     486  nv = SIZE(v)
     487  ALLOCATE(vdup(n*nv))
     488  DO i = 1, n; vdup(1+(i-1)*nv:i*nv) = v; END DO
     489END SUBROUTINE dupl_r
     490!==============================================================================================================================
     491SUBROUTINE dupl_l(v, n, vdup)
     492  LOGICAL,              INTENT(IN)  :: v(:)
     493  INTEGER,              INTENT(IN)  :: n
     494  LOGICAL, ALLOCATABLE, INTENT(OUT) :: vdup(:)
     495!------------------------------------------------------------------------------------------------------------------------------
     496  INTEGER :: nv, i
     497  nv = SIZE(v)
     498  ALLOCATE(vdup(n*nv))
     499  DO i = 1, n; vdup(1+(i-1)*nv:i*nv) = v; END DO
     500END SUBROUTINE dupl_l
    451501!==============================================================================================================================
    452502
Note: See TracChangeset for help on using the changeset viewer.