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/dimension.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/dimension.f90

    r9598 r12080  
    22! NEMO system team, System and Interface for oceanic RElocable Nesting 
    33!---------------------------------------------------------------------- 
    4 ! 
    5 ! MODULE: dim 
    64! 
    75! DESCRIPTION: 
    … …  
    152150!> 
    153151!> @author J.Paul 
    154 ! REVISION HISTORY: 
     152!> 
    155153!> @date November, 2013 - Initial Version 
    156 !> @date Spetember, 2015 
     154!> @date September, 2015 
    157155!> - manage useless (dummy) dimension 
    158156!> @date October, 2016 
    159157!> - dimension allowed read in configuration file 
    160 !> 
    161 !> @note Software governed by the CeCILL licence     (./LICENSE) 
     158!> @date May, 2019 
     159!> - read number of element for each dimension allowed in configuration file  
     160!> - read number of element for each dummy array in configuration file 
     161!> 
     162!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    162163!---------------------------------------------------------------------- 
    163164MODULE dim 
     165 
    164166   USE global                          ! global variable 
    165167   USE kind                            ! F90 kind parameter 
    166168   USE logger                          ! log file manager 
    167169   USE fct                             ! basic useful function 
     170 
    168171   IMPLICIT NONE 
    169172   ! NOTE_avoid_public_variables_if_possible 
    … …  
    172175   PUBLIC :: TDIM              !< dimension structure 
    173176 
     177   PRIVATE :: im_ndumdim       !< number of elt in dummy dimension array 
    174178   PRIVATE :: cm_dumdim        !< dummy dimension array 
     179   PRIVATE :: im_dimX          !< number of elt in x dimension array 
     180   PRIVATE :: im_dimY          !< number of elt in y dimension array 
     181   PRIVATE :: im_dimZ          !< number of elt in z dimension array 
     182   PRIVATE :: im_dimT          !< number of elt in t dimension array 
    175183   PRIVATE :: cm_dimX          !< x dimension array 
    176184   PRIVATE :: cm_dimY          !< y dimension array 
    … …  
    223231   END TYPE 
    224232 
    225    CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg), SAVE :: cm_dumdim !< dummy dimension 
    226    CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimX   !< x dimension 
    227    CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimY   !< y dimension 
    228    CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimZ   !< z dimension 
    229    CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimT   !< t dimension 
     233   INTEGER(i4)                               , SAVE :: im_ndumdim !< number of elt in dummy dimension array 
     234   CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg), SAVE :: cm_dumdim  !< dummy dimension 
     235   INTEGER(i4)                               , SAVE :: im_dimX    !< number of elt in x dimension array 
     236   INTEGER(i4)                               , SAVE :: im_dimY    !< number of elt in y dimension array 
     237   INTEGER(i4)                               , SAVE :: im_dimZ    !< number of elt in z dimension array 
     238   INTEGER(i4)                               , SAVE :: im_dimT    !< number of elt in t dimension array 
     239   CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimX    !< x dimension 
     240   CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimY    !< y dimension 
     241   CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimZ    !< z dimension 
     242   CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimT    !< t dimension 
    230243 
    231244   INTERFACE dim_print 
    … …  
    265278 
    266279CONTAINS 
     280   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     281   FUNCTION dim__copy_arr(td_dim) & 
     282         & RESULT (tf_dim) 
    267283   !------------------------------------------------------------------- 
    268284   !> @brief 
    … …  
    283299   !> @return copy of input array of dimension structure 
    284300   !------------------------------------------------------------------- 
    285    FUNCTION dim__copy_arr( td_dim ) 
    286       IMPLICIT NONE 
     301 
     302      IMPLICIT NONE 
     303 
    287304      ! Argument 
    288       TYPE(TDIM), DIMENSION(:), INTENT(IN) :: td_dim 
     305      TYPE(TDIM), DIMENSION(:), INTENT(IN)   :: td_dim 
     306 
    289307      ! function 
    290       TYPE(TDIM), DIMENSION(SIZE(td_dim(:))) :: dim__copy_arr 
     308      TYPE(TDIM), DIMENSION(SIZE(td_dim(:))) :: tf_dim 
    291309 
    292310      ! local variable 
    … …  
    296314 
    297315      DO ji=1,SIZE(td_dim(:)) 
    298          dim__copy_arr(ji)=dim_copy(td_dim(ji)) 
     316         tf_dim(ji)=dim_copy(td_dim(ji)) 
    299317      ENDDO 
    300318 
    301319   END FUNCTION dim__copy_arr 
     320   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     321   FUNCTION dim__copy_unit(td_dim) & 
     322         & RESULT (tf_dim) 
    302323   !------------------------------------------------------------------- 
    303324   !> @brief 
    … …  
    318339   !> @return copy of input dimension structure 
    319340   !------------------------------------------------------------------- 
    320    FUNCTION dim__copy_unit( td_dim ) 
    321       IMPLICIT NONE 
     341 
     342      IMPLICIT NONE 
     343 
    322344      ! Argument 
    323345      TYPE(TDIM), INTENT(IN)  :: td_dim 
     346 
    324347      ! function 
    325       TYPE(TDIM) :: dim__copy_unit 
     348      TYPE(TDIM)              :: tf_dim 
    326349 
    327350      ! local variable 
    328351      !---------------------------------------------------------------- 
    329352 
    330       dim__copy_unit=td_dim 
     353      tf_dim=td_dim 
    331354 
    332355   END FUNCTION dim__copy_unit 
     356   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     357   FUNCTION dim_get_index(td_dim, cd_name, cd_sname) & 
     358         & RESULT (if_idx) 
    333359   !------------------------------------------------------------------- 
    334360   !> @brief This function returns dimension index, 
    … …  
    349375   !> @return dimension index 
    350376   !------------------------------------------------------------------- 
    351    INTEGER(i4) FUNCTION dim_get_index( td_dim, cd_name, cd_sname ) 
    352       IMPLICIT NONE 
     377 
     378      IMPLICIT NONE 
     379 
    353380      ! Argument 
    354381      TYPE(TDIM)      , DIMENSION(:), INTENT(IN) :: td_dim 
    355382      CHARACTER(LEN=*),               INTENT(IN) :: cd_name 
    356383      CHARACTER(LEN=*),               INTENT(IN), OPTIONAL :: cd_sname 
     384 
     385      ! function 
     386      INTEGER(i4)                                :: if_idx 
    357387 
    358388      ! local variable 
    … …  
    366396      ! loop indices 
    367397      INTEGER(i4) :: ji 
    368       INTEGER(i4) :: jj 
    369398      !---------------------------------------------------------------- 
    370399      ! init 
    371       dim_get_index=0 
     400      if_idx=0 
    372401 
    373402      il_ndim=SIZE(td_dim(:)) 
    … …  
    376405      cl_name=fct_lower(cd_name) 
    377406      ! check if dimension is in array of dimension structure 
    378       jj=0 
    379407      DO ji=1,il_ndim 
    380408         cl_dim_name=fct_lower(td_dim(ji)%c_name) 
    381409         IF( TRIM(cl_dim_name) == TRIM(cl_name) )THEN 
    382              dim_get_index=ji 
    383              EXIT 
     410            if_idx=ji 
     411            EXIT 
    384412         ENDIF 
    385413      ENDDO 
    386414 
    387415      ! look for dimension short name 
    388       IF(  dim_get_index == 0 )THEN 
     416      IF(  if_idx == 0 )THEN 
    389417 
    390418         cl_sname=fct_lower(cd_name) 
    391419         ! check if dimension is in array of dimension structure 
    392          jj=0 
    393420         DO ji=1,il_ndim 
    394421            cl_dim_sname=fct_lower(td_dim(ji)%c_sname) 
    395422            IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ) )THEN 
    396423               CALL logger_debug("DIM GET INDEX: variable short name "//& 
    397                &  TRIM(ADJUSTL(cd_name))//" already in file") 
    398                dim_get_index=ji 
     424                  &              TRIM(ADJUSTL(cd_name))//" already in file") 
     425               if_idx=ji 
    399426               EXIT 
    400427            ENDIF 
    … …  
    405432      ! look for dimension short name 
    406433      IF( PRESENT(cd_sname) )THEN 
    407          IF(  dim_get_index == 0 )THEN 
     434         IF( if_idx == 0 )THEN 
    408435 
    409436            cl_sname=fct_lower(cd_sname) 
    410437            ! check if dimension is in array of dimension structure 
    411             jj=0 
    412438            DO ji=1,il_ndim 
    413439               cl_dim_sname=fct_lower(td_dim(ji)%c_sname) 
    414440               IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ) )THEN 
    415441                  CALL logger_debug("DIM GET INDEX: variable short name "//& 
    416                   &  TRIM(ADJUSTL(cd_sname))//" already in file") 
    417                   dim_get_index=ji 
     442                     &              TRIM(ADJUSTL(cd_sname))//" already in file") 
     443                  if_idx=ji 
    418444                  EXIT 
    419445               ENDIF 
    … …  
    424450 
    425451   END FUNCTION dim_get_index 
     452   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     453   FUNCTION dim_get_id(td_dim, cd_name, cd_sname) & 
     454         & RESULT (if_id) 
    426455   !------------------------------------------------------------------- 
    427456   !> @brief This function returns dimension id, in a array of dimension structure, 
    … …  
    437466   !> @return dimension id 
    438467   !------------------------------------------------------------------- 
    439    INTEGER(i4) FUNCTION dim_get_id( td_dim, cd_name, cd_sname ) 
    440       IMPLICIT NONE 
     468    
     469      IMPLICIT NONE 
     470 
    441471      ! Argument 
    442472      TYPE(TDIM),       DIMENSION(:), INTENT(IN) :: td_dim 
    443473      CHARACTER(LEN=*),               INTENT(IN) :: cd_name 
    444474      CHARACTER(LEN=*),               INTENT(IN), OPTIONAL :: cd_sname 
     475 
     476      ! function 
     477      INTEGER(i4)                                :: if_id 
    445478 
    446479      ! local variable 
    … …  
    457490      !---------------------------------------------------------------- 
    458491      ! init 
    459       dim_get_id=0 
     492      if_id=0 
    460493 
    461494      il_ndim=SIZE(td_dim(:)) 
    … …  
    470503         &   td_dim(ji)%l_use )THEN 
    471504            IF( td_dim(ji)%i_id /= 0 )THEN 
    472                dim_get_id=td_dim(ji)%i_id 
     505               if_id=td_dim(ji)%i_id 
    473506               EXIT 
    474507            ENDIF 
    … …  
    477510 
    478511      ! look for dimension short name 
    479       IF(  dim_get_id == 0 )THEN 
     512      IF(  if_id == 0 )THEN 
    480513 
    481514         cl_sname=fct_lower(cd_name) 
    … …  
    487520            &   td_dim(ji)%l_use )THEN 
    488521               IF( td_dim(ji)%i_id /= 0 )THEN 
    489                   dim_get_id=td_dim(ji)%i_id 
     522                  if_id=td_dim(ji)%i_id 
    490523                  EXIT 
    491524               ENDIF 
    … …  
    497530      ! look for dimension short name 
    498531      IF( PRESENT(cd_sname) )THEN 
    499          IF(  dim_get_id == 0 )THEN 
     532         IF(  if_id == 0 )THEN 
    500533 
    501534            cl_sname=fct_lower(cd_sname) 
    … …  
    505538               cl_dim_sname=fct_lower(td_dim(ji)%c_sname) 
    506539               IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ).AND.& 
    507                &  td_dim(ji)%l_use )THEN 
     540                  & td_dim(ji)%l_use )THEN 
    508541                  IF( td_dim(ji)%i_id /= 0 )THEN 
    509                      dim_get_id=td_dim(ji)%i_id 
     542                     if_id=td_dim(ji)%i_id 
    510543                     EXIT 
    511544                  ENDIF 
    … …  
    517550 
    518551   END FUNCTION dim_get_id 
     552   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     553   FUNCTION dim_init(cd_name, id_len, ld_uld, cd_sname, ld_use) & 
     554         & RESULT (tf_dim) 
    519555   !------------------------------------------------------------------- 
    520556   !> @brief This function initialize a dimension structure with given 
    … …  
    533569   !> - Bug fix: inform order to disorder table instead of disorder to order 
    534570   !> table 
    535    ! 
     571   !> @date May, 2019 
     572   !> - use number of element for each dimention allowed, instead of while loop 
     573   !> 
    536574   !> @param[in] cd_name   dimension name 
    537575   !> @param[in] id_len    dimension length 
    … …  
    541579   !> @return dimension structure 
    542580   !------------------------------------------------------------------- 
    543    TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname, ld_use ) 
     581 
    544582      IMPLICIT NONE 
    545583 
    … …  
    551589      LOGICAL,          INTENT(IN), OPTIONAL :: ld_use 
    552590 
     591      ! function 
     592      TYPE(TDIM)                    :: tf_dim 
     593 
    553594      ! local variable 
    554595      CHARACTER(LEN=lc) :: cl_name 
    … …  
    557598 
    558599      ! clean dimension 
    559       CALL dim_clean(dim_init) 
     600      CALL dim_clean(tf_dim) 
    560601 
    561602      cl_name=fct_upper(cd_name) 
    … …  
    563604      CALL logger_debug( & 
    564605      &  " DIM INIT: dimension name: "//TRIM(cl_name) ) 
    565       dim_init%c_name=TRIM(ADJUSTL(cd_name)) 
     606      tf_dim%c_name=TRIM(ADJUSTL(cd_name)) 
    566607 
    567608      IF( PRESENT(id_len) )THEN 
    568609         CALL logger_debug( & 
    569610         &  " DIM INIT: dimension length: "//fct_str(id_len) ) 
    570          dim_init%i_len=id_len 
     611         tf_dim%i_len=id_len 
    571612      ENDIF 
    572613 
    573614      ! define dimension is supposed to be used 
    574615      IF( PRESENT(ld_use) )THEN 
    575          dim_init%l_use=ld_use 
     616         tf_dim%l_use=ld_use 
    576617      ELSE 
    577          dim_init%l_use=.TRUE. 
     618         tf_dim%l_use=.TRUE. 
    578619      ENDIF 
    579620 
    … …  
    588629            CALL logger_debug( & 
    589630            &  " DIM INIT: dimension short name: "//TRIM(cd_sname) ) 
    590             dim_init%c_sname=TRIM(cd_sname) 
     631            tf_dim%c_sname=TRIM(cd_sname) 
    591632         ELSE 
    592633            CALL logger_warn("DIM INIT: invalid short name."//& 
    … …  
    595636      ENDIF 
    596637 
    597       IF( TRIM(fct_lower(dim_init%c_sname)) == 'u' )THEN 
     638      IF( TRIM(fct_lower(tf_dim%c_sname)) == 'u' )THEN 
    598639 
    599640         cl_name=fct_lower(cd_name) 
    600641 
    601          IF(     dim__is_allowed(TRIM(cl_name), cm_dimX(:)) )THEN 
    602             dim_init%c_sname='x' 
    603          ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimY(:)) )THEN 
    604             dim_init%c_sname='y' 
    605          ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimZ(:)) )THEN 
    606             dim_init%c_sname='z' 
    607          ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimT(:)) )THEN 
    608             dim_init%c_sname='t' 
     642         IF(     dim__is_allowed(TRIM(cl_name), cm_dimX(:), im_dimX) )THEN 
     643            tf_dim%c_sname='x' 
     644         ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimY(:), im_dimY) )THEN 
     645            tf_dim%c_sname='y' 
     646         ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimZ(:), im_dimZ) )THEN 
     647            tf_dim%c_sname='z' 
     648         ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimT(:), im_dimT) )THEN 
     649            tf_dim%c_sname='t' 
    609650         ELSE 
    610651            CALL logger_warn("DIM INIT: "//TRIM(cd_name)//& 
    … …  
    617658         CALL logger_debug( & 
    618659         &  " DIM INIT: unlimited dimension: "//fct_str(ld_uld) ) 
    619          dim_init%l_uld=ld_uld 
     660         tf_dim%l_uld=ld_uld 
    620661      ELSE 
    621          IF( TRIM(fct_lower(dim_init%c_sname)) =='t'  )THEN 
    622             dim_init%l_uld=.TRUE. 
     662         IF( TRIM(fct_lower(tf_dim%c_sname)) =='t'  )THEN 
     663            tf_dim%l_uld=.TRUE. 
    623664         ENDIF 
    624665      ENDIF 
    625666       
    626667      ! get dimension order indices 
    627       dim_init%i_xyzt2=SCAN(TRIM(cp_dimorder),TRIM(dim_init%c_sname)) 
     668      tf_dim%i_xyzt2=SCAN(TRIM(cp_dimorder),TRIM(tf_dim%c_sname)) 
    628669 
    629670   END FUNCTION dim_init 
     671   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     672   SUBROUTINE dim__print_arr(td_dim) 
    630673   !------------------------------------------------------------------- 
    631674   !> @brief This subroutine print informations of an array of dimension.  
    … …  
    636679   !> @param[in] td_dim array of dimension structure 
    637680   !------------------------------------------------------------------- 
    638    SUBROUTINE dim__print_arr(td_dim) 
     681 
    639682      IMPLICIT NONE 
    640683 
    … …  
    651694 
    652695   END SUBROUTINE dim__print_arr 
     696   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     697   SUBROUTINE dim__print_unit(td_dim) 
    653698   !------------------------------------------------------------------- 
    654699   !> @brief This subrtoutine print dimension information.  
    … …  
    659704   !> @param[in] td_dim dimension structure 
    660705   !------------------------------------------------------------------- 
    661    SUBROUTINE dim__print_unit(td_dim) 
     706 
    662707      IMPLICIT NONE 
    663708 
    … …  
    666711      !---------------------------------------------------------------- 
    667712 
    668       WRITE(*,'((3x,a,a),(/6x,a,a),(a,i1),(a,i4),2(a,a),2(a,i1))')   & 
     713      WRITE(*,'((3x,a,a),(/6x,a,a),(a,i1),(a,i5),2(a,a),2(a,i1))')   & 
    669714      &        " dimension : ",TRIM(td_dim%c_name),               & 
    670715      &        " short name : ",TRIM(td_dim%c_sname),        & 
    … …  
    677722 
    678723   END SUBROUTINE dim__print_unit 
     724   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     725   FUNCTION dim_fill_unused(td_dim) & 
     726         & RESULT (tf_dim) 
    679727   !------------------------------------------------------------------- 
    680728   !> @brief This function fill unused dimension of an array of dimension 
    … …  
    695743   !> @return  4elts array of dimension structure 
    696744   !------------------------------------------------------------------- 
    697    FUNCTION dim_fill_unused(td_dim) 
    698       IMPLICIT NONE 
     745 
     746      IMPLICIT NONE 
     747 
    699748      ! Argument       
    700749      TYPE(TDIM), DIMENSION(:), INTENT(IN), OPTIONAL :: td_dim 
    701750 
    702751      ! function 
    703       TYPE(TDIM), DIMENSION(ip_maxdim) :: dim_fill_unused 
     752      TYPE(TDIM), DIMENSION(ip_maxdim)               :: tf_dim 
    704753 
    705754      ! local variable 
    … …  
    707756      INTEGER(i4)      , DIMENSION(1)         :: il_ind  ! index 
    708757       
    709       TYPE(TDIM),        DIMENSION(ip_maxdim) :: tl_dim 
    710  
    711758      ! loop indices 
    712759      INTEGER(i4) :: ji 
    … …  
    714761 
    715762      IF( PRESENT(td_dim) )THEN 
    716          tl_dim(1:SIZE(td_dim(:)))=td_dim(:) 
     763         tf_dim(1:SIZE(td_dim(:)))=td_dim(:) 
    717764      ENDIF 
    718765      ! concatenate short nem dimension in a character string 
    719       cl_dimin=fct_lower(fct_concat(tl_dim(:)%c_sname)) 
     766      cl_dimin=fct_lower(fct_concat(tf_dim(:)%c_sname)) 
    720767      DO ji = 1, ip_maxdim 
    721768 
    … …  
    723770         IF( INDEX(cl_dimin,TRIM(fct_lower(cp_dimorder(ji:ji)))) == 0 )THEN 
    724771            ! search first empty dimension (see dim_init) 
    725             il_ind(:)=MINLOC( tl_dim(:)%i_xyzt2, tl_dim(:)%i_xyzt2 == 0 ) 
     772            il_ind(:)=MINLOC( tf_dim(:)%i_xyzt2, tf_dim(:)%i_xyzt2 == 0 ) 
    726773 
    727774            ! put missing dimension instead of empty one 
    728             tl_dim(il_ind(1))%c_sname=fct_lower(cp_dimorder(ji:ji)) 
     775            tf_dim(il_ind(1))%c_sname=fct_lower(cp_dimorder(ji:ji)) 
    729776            ! update output structure 
    730             tl_dim(il_ind(1))%c_name=fct_lower(cp_dimorder(ji:ji)) 
    731             tl_dim(il_ind(1))%i_xyzt2=ji 
    732             tl_dim(il_ind(1))%i_len=1 
    733             tl_dim(il_ind(1))%l_use=.FALSE. 
     777            tf_dim(il_ind(1))%c_name=fct_lower(cp_dimorder(ji:ji)) 
     778            tf_dim(il_ind(1))%i_xyzt2=ji 
     779            tf_dim(il_ind(1))%i_len=1 
     780            tf_dim(il_ind(1))%l_use=.FALSE. 
    734781         ENDIF 
    735782 
    736783      ENDDO 
    737784          
    738       ! save result 
    739       dim_fill_unused(:)=tl_dim(:) 
    740  
    741       ! clean 
    742       CALL dim_clean(tl_dim(:)) 
    743  
    744785   END FUNCTION dim_fill_unused 
     786   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     787   SUBROUTINE dim_reorder(td_dim, cd_dimorder) 
    745788   !------------------------------------------------------------------- 
    746789   !> @brief  
    … …  
    764807   !> @param[in] cd_dimorder  dimension order to be output  
    765808   !------------------------------------------------------------------- 
    766    SUBROUTINE dim_reorder(td_dim, cd_dimorder) 
    767       IMPLICIT NONE 
     809 
     810      IMPLICIT NONE 
     811 
    768812      ! Argument       
    769813      TYPE(TDIM)              , DIMENSION(:), INTENT(INOUT) :: td_dim 
    … …  
    846890 
    847891   END SUBROUTINE dim_reorder 
     892   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     893   SUBROUTINE dim_disorder(td_dim) 
    848894   !------------------------------------------------------------------- 
    849895   !> @brief This subroutine switch dimension array from ordered dimension ('x','y','z','t') 
    … …  
    859905   !> @param[inout] td_dim array of dimension structure 
    860906   !------------------------------------------------------------------- 
    861    SUBROUTINE dim_disorder(td_dim) 
    862       IMPLICIT NONE 
     907 
     908      IMPLICIT NONE 
     909 
    863910      ! Argument       
    864911      TYPE(TDIM), DIMENSION(:), INTENT(INOUT) :: td_dim 
    … …  
    906953 
    907954   END SUBROUTINE dim_disorder 
     955   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     956   FUNCTION dim__reshape_2xyzt_dp(td_dim, dd_value) & 
     957         & RESULT (df_value) 
    908958   !------------------------------------------------------------------- 
    909959   !> @brief This function reshape real(8) 4D array    
    … …  
    918968   !> @author J.Paul 
    919969   !> @date November, 2013 - Initial Version 
    920    ! 
     970   !> @date January, 2019 
     971   !> - do not reshape array already order 
     972   !> 
    921973   !> @param[in] td_dim    array of dimension structure 
    922974   !> @param[in] dd_value  array of value to reshape 
    923975   !> @return array of value reshaped  
    924976   !------------------------------------------------------------------- 
    925    FUNCTION dim__reshape_2xyzt_dp(td_dim, dd_value) 
     977 
    926978      IMPLICIT NONE 
    927979 
    … …  
    932984      ! function 
    933985      REAL(dp), DIMENSION(td_dim(1)%i_len, & 
    934       &                   td_dim(2)%i_len, & 
    935       &                   td_dim(3)%i_len, & 
    936       &                   td_dim(4)%i_len) :: dim__reshape_2xyzt_dp 
     986         &                td_dim(2)%i_len, & 
     987         &                td_dim(3)%i_len, & 
     988         &                td_dim(4)%i_len)       :: df_value 
    937989 
    938990      ! local variable 
    … …  
    942994      ! loop indices 
    943995      INTEGER(i4) :: ji 
     996      INTEGER(i4) :: jj 
     997      INTEGER(i4) :: jk 
     998      INTEGER(i4) :: jl 
    944999      !---------------------------------------------------------------- 
    9451000 
    … …  
    9661021            DO ji=1,ip_maxdim 
    9671022               CALL logger_debug(" DIM RESHAPE 2 XYZT: dim "//& 
    968                &     TRIM(td_dim(td_dim(ji)%i_xyzt2)%c_name)//" "//& 
    969                &     TRIM(fct_str(td_dim(td_dim(ji)%i_xyzt2)%i_len))//" vs "//& 
    970                &     TRIM(fct_str(il_shape(ji))) ) 
     1023                  &     TRIM(td_dim(td_dim(ji)%i_xyzt2)%c_name)//" "//& 
     1024                  &     TRIM(fct_str(td_dim(td_dim(ji)%i_xyzt2)%i_len))//" vs "//& 
     1025                  &     TRIM(fct_str(il_shape(ji))) ) 
    9711026            ENDDO 
    9721027            CALL logger_fatal(" DIM RESHAPE 2 XYZT: wrong input dimensions " ) 
    … …  
    9931048            &  TRIM(cl_dim) ) 
    9941049 
     1050            IF( td_dim(1)%i_xyzt2 == 1 .AND. & 
     1051              & td_dim(2)%i_xyzt2 == 2 .AND. &    
     1052              & td_dim(3)%i_xyzt2 == 3 .AND. &    
     1053              & td_dim(4)%i_xyzt2 == 4 )THEN      
     1054    
     1055               DO jl=1,td_dim(4)%i_len 
     1056                  DO jk=1,td_dim(3)%i_len 
     1057                     DO jj=1,td_dim(2)%i_len 
     1058                        DO ji=1,td_dim(1)%i_len 
     1059                           df_value(ji,jj,jk,jl)=dd_value(ji,jj,jk,jl) 
     1060                        ENDDO 
     1061                     ENDDO    
     1062                  ENDDO 
     1063               ENDDO 
     1064 
     1065            ELSE 
     1066 
    9951067               ! reorder dimension to x,y,z,t 
    996                dim__reshape_2xyzt_dp(:,:,:,:)=RESHAPE(SOURCE=dd_value(:,:,:,:),& 
    997                &                 SHAPE = (/ td_dim(1)%i_len,   & 
    998                &                            td_dim(2)%i_len,   & 
    999                &                            td_dim(3)%i_len,   & 
    1000                &                            td_dim(4)%i_len /),& 
    1001                &                 ORDER = (/ td_dim(1)%i_2xyzt,          & 
    1002                &                            td_dim(2)%i_2xyzt,          & 
    1003                &                            td_dim(3)%i_2xyzt,          & 
    1004                &                            td_dim(4)%i_2xyzt        /))       
    1005  
     1068               df_value(:,:,:,:)=RESHAPE(SOURCE=dd_value(:,:,:,:),& 
     1069                  &                 SHAPE = (/ td_dim(1)%i_len,   & 
     1070                  &                            td_dim(2)%i_len,   & 
     1071                  &                            td_dim(3)%i_len,   & 
     1072                  &                            td_dim(4)%i_len /),& 
     1073                  &                 ORDER = (/ td_dim(1)%i_2xyzt, & 
     1074                  &                            td_dim(2)%i_2xyzt, & 
     1075                  &                            td_dim(3)%i_2xyzt, & 
     1076                  &                            td_dim(4)%i_2xyzt /))       
     1077            ENDIF 
    10061078         ENDIF 
    10071079      ENDIF 
    10081080 
    10091081   END FUNCTION dim__reshape_2xyzt_dp 
     1082   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1083   FUNCTION dim__reshape_xyzt2_dp(td_dim, dd_value) & 
     1084         & RESULT (df_value) 
    10101085   !------------------------------------------------------------------- 
    10111086   !> @brief This function reshape ordered real(8) 4D array with dimension  
    … …  
    10251100   !> @return array of value reshaped  
    10261101   !------------------------------------------------------------------- 
    1027    FUNCTION dim__reshape_xyzt2_dp(td_dim, dd_value) 
     1102 
    10281103      IMPLICIT NONE 
    10291104       
    … …  
    10341109      ! function 
    10351110      REAL(dp), DIMENSION(td_dim(td_dim(1)%i_xyzt2)%i_len, & 
    1036       &                   td_dim(td_dim(2)%i_xyzt2)%i_len, & 
    1037       &                   td_dim(td_dim(3)%i_xyzt2)%i_len, & 
    1038       &                   td_dim(td_dim(4)%i_xyzt2)%i_len) :: dim__reshape_xyzt2_dp 
     1111         &                td_dim(td_dim(2)%i_xyzt2)%i_len, & 
     1112         &                td_dim(td_dim(3)%i_xyzt2)%i_len, & 
     1113         &                td_dim(td_dim(4)%i_xyzt2)%i_len) :: df_value 
    10391114 
    10401115      ! local variable 
    … …  
    10951170 
    10961171            ! reshape array 
    1097             dim__reshape_xyzt2_dp(:,:,:,:)=RESHAPE(SOURCE=dd_value,  & 
    1098             &           SHAPE = (/ td_dim(td_dim(1)%i_xyzt2)%i_len,   & 
    1099             &                      td_dim(td_dim(2)%i_xyzt2)%i_len,   & 
    1100             &                      td_dim(td_dim(3)%i_xyzt2)%i_len,   & 
    1101             &                      td_dim(td_dim(4)%i_xyzt2)%i_len /),& 
    1102             &           ORDER = (/        td_dim(1)%i_xyzt2,          & 
    1103             &                             td_dim(2)%i_xyzt2,          & 
    1104             &                             td_dim(3)%i_xyzt2,          & 
    1105             &                             td_dim(4)%i_xyzt2        /)) 
     1172            df_value(:,:,:,:)=RESHAPE(SOURCE=dd_value,  & 
     1173               &           SHAPE = (/ td_dim(td_dim(1)%i_xyzt2)%i_len,   & 
     1174               &                      td_dim(td_dim(2)%i_xyzt2)%i_len,   & 
     1175               &                      td_dim(td_dim(3)%i_xyzt2)%i_len,   & 
     1176               &                      td_dim(td_dim(4)%i_xyzt2)%i_len /),& 
     1177               &           ORDER = (/        td_dim(1)%i_xyzt2,          & 
     1178               &                             td_dim(2)%i_xyzt2,          & 
     1179               &                             td_dim(3)%i_xyzt2,          & 
     1180               &                             td_dim(4)%i_xyzt2        /)) 
    11061181 
    11071182         ENDIF       
    … …  
    11091184 
    11101185   END FUNCTION dim__reshape_xyzt2_dp 
     1186   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1187   FUNCTION dim__reorder_2xyzt_i4(td_dim, id_arr) & 
     1188         & RESULT (if_value) 
    11111189   !------------------------------------------------------------------- 
    11121190   !> @brief  This function reordered integer(4) 1D array to be suitable  
    … …  
    11211199   !> @return array of value reshaped  
    11221200   !------------------------------------------------------------------- 
    1123    FUNCTION dim__reorder_2xyzt_i4(td_dim, id_arr) 
     1201 
    11241202      IMPLICIT NONE 
    11251203 
    … …  
    11291207       
    11301208      ! function 
    1131       INTEGER(i4), DIMENSION(ip_maxdim) :: dim__reorder_2xyzt_i4 
     1209      INTEGER(i4), DIMENSION(ip_maxdim)     :: if_value 
    11321210 
    11331211      ! loop indices 
    … …  
    11491227 
    11501228         DO ji=1,ip_maxdim 
    1151             dim__reorder_2xyzt_i4(ji)=id_arr(td_dim(ji)%i_2xyzt) 
     1229            if_value(ji)=id_arr(td_dim(ji)%i_2xyzt) 
    11521230         ENDDO 
    11531231      ENDIF 
    11541232 
    11551233   END FUNCTION dim__reorder_2xyzt_i4 
     1234   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1235   FUNCTION dim__reorder_xyzt2_i4(td_dim, id_arr) & 
     1236         & RESULT (if_value) 
    11561237   !------------------------------------------------------------------- 
    11571238   !> @brief This function disordered integer(4) 1D array to be suitable with 
    … …  
    11661247   !> @return array of value reshaped  
    11671248   !------------------------------------------------------------------- 
    1168    FUNCTION dim__reorder_xyzt2_i4(td_dim, id_arr) 
     1249 
    11691250      IMPLICIT NONE 
    11701251 
    … …  
    11721253      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim 
    11731254      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_arr 
    1174        
     1255  
    11751256      ! function 
    1176       INTEGER(i4), DIMENSION(ip_maxdim) :: dim__reorder_xyzt2_i4 
    1177        
     1257      INTEGER(i4), DIMENSION(ip_maxdim)     :: if_value 
     1258  
    11781259      ! loop indices 
    11791260      INTEGER(i4) :: ji 
    … …  
    11941275 
    11951276         DO ji=1,ip_maxdim 
    1196             dim__reorder_xyzt2_i4(ji)=id_arr(td_dim(ji)%i_xyzt2) 
     1277            if_value(ji)=id_arr(td_dim(ji)%i_xyzt2) 
    11971278         ENDDO 
    11981279      ENDIF 
    11991280 
    12001281   END FUNCTION dim__reorder_xyzt2_i4 
     1282   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1283   FUNCTION dim__reorder_2xyzt_l(td_dim, ld_arr) & 
     1284         & RESULT (lf_arr) 
    12011285   !------------------------------------------------------------------- 
    12021286   !> @brief  This function reordered logical 1D array to be suitable  
    … …  
    12111295   !> @return array of value reordered  
    12121296   !------------------------------------------------------------------- 
    1213    FUNCTION dim__reorder_2xyzt_l(td_dim, ld_arr) 
    1214       IMPLICIT NONE 
     1297 
     1298      IMPLICIT NONE 
     1299 
    12151300      ! Argument       
    12161301      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim 
    … …  
    12181303       
    12191304      ! function 
    1220       LOGICAL, DIMENSION(ip_maxdim) :: dim__reorder_2xyzt_l 
     1305      LOGICAL, DIMENSION(ip_maxdim)         :: lf_arr 
    12211306 
    12221307      ! loop indices 
    … …  
    12381323 
    12391324         DO ji=1,ip_maxdim 
    1240             dim__reorder_2xyzt_l(ji)=ld_arr(td_dim(ji)%i_2xyzt) 
     1325            lf_arr(ji)=ld_arr(td_dim(ji)%i_2xyzt) 
    12411326         ENDDO 
    12421327      ENDIF 
    12431328 
    12441329   END FUNCTION dim__reorder_2xyzt_l 
     1330   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1331   FUNCTION dim__reorder_xyzt2_l(td_dim, ld_arr) & 
     1332         & RESULT (lf_arr) 
    12451333   !------------------------------------------------------------------- 
    12461334   !> @brief This function disordered logical 1D array to be suitable with 
    … …  
    12551343   !> @return array of value reordered  
    12561344   !------------------------------------------------------------------- 
    1257    FUNCTION dim__reorder_xyzt2_l(td_dim, ld_arr) 
     1345 
    12581346      IMPLICIT NONE 
    12591347 
    … …  
    12611349      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim 
    12621350      LOGICAL    , DIMENSION(:), INTENT(IN) :: ld_arr 
    1263        
     1351  
    12641352      ! function 
    1265       LOGICAL, DIMENSION(ip_maxdim) :: dim__reorder_xyzt2_l 
    1266        
     1353      LOGICAL, DIMENSION(ip_maxdim)         :: lf_arr 
     1354  
    12671355      ! loop indices 
    12681356      INTEGER(i4) :: ji 
    … …  
    12831371 
    12841372         DO ji=1,ip_maxdim 
    1285             dim__reorder_xyzt2_l(ji)=ld_arr(td_dim(ji)%i_xyzt2) 
     1373            lf_arr(ji)=ld_arr(td_dim(ji)%i_xyzt2) 
    12861374         ENDDO 
    12871375      ENDIF 
    12881376 
    12891377   END FUNCTION dim__reorder_xyzt2_l 
     1378   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1379   FUNCTION dim__reorder_2xyzt_c(td_dim, cd_arr) & 
     1380         & RESULT (cf_arr) 
    12901381   !------------------------------------------------------------------- 
    12911382   !> @brief  This function reordered string 1D array to be suitable  
    … …  
    13001391   !> @return array of value reordered  
    13011392   !------------------------------------------------------------------- 
    1302    FUNCTION dim__reorder_2xyzt_c(td_dim, cd_arr) 
    1303       IMPLICIT NONE 
     1393 
     1394      IMPLICIT NONE 
     1395 
    13041396      ! Argument       
    13051397      TYPE(TDIM),       DIMENSION(:), INTENT(IN) :: td_dim 
    13061398      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_arr 
    1307        
     1399  
    13081400      ! function 
    1309       CHARACTER(LEN=lc), DIMENSION(ip_maxdim) :: dim__reorder_2xyzt_c 
     1401      CHARACTER(LEN=lc), DIMENSION(ip_maxdim)    :: cf_arr 
    13101402 
    13111403      ! loop indices 
    … …  
    13271419 
    13281420         DO ji=1,ip_maxdim 
    1329             dim__reorder_2xyzt_c(ji)=TRIM(cd_arr(td_dim(ji)%i_2xyzt)) 
     1421            cf_arr(ji)=TRIM(cd_arr(td_dim(ji)%i_2xyzt)) 
    13301422         ENDDO 
    13311423      ENDIF 
    13321424 
    13331425   END FUNCTION dim__reorder_2xyzt_c 
     1426   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1427   FUNCTION dim__reorder_xyzt2_c(td_dim, cd_arr) & 
     1428         & RESULT (cf_arr) 
    13341429   !------------------------------------------------------------------- 
    13351430   !> @brief This function disordered string 1D array to be suitable with 
    … …  
    13441439   !> @return array of value reordered  
    13451440   !------------------------------------------------------------------- 
    1346    FUNCTION dim__reorder_xyzt2_c(td_dim, cd_arr) 
     1441 
    13471442      IMPLICIT NONE 
    13481443 
    … …  
    13501445      TYPE(TDIM),       DIMENSION(:), INTENT(IN) :: td_dim 
    13511446      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_arr 
    1352        
     1447  
    13531448      ! function 
    1354       CHARACTER(LEN=lc), DIMENSION(ip_maxdim) :: dim__reorder_xyzt2_c 
     1449      CHARACTER(LEN=lc), DIMENSION(ip_maxdim) :: cf_arr 
    13551450       
    13561451      ! loop indices 
    … …  
    13711466 
    13721467         DO ji=1,ip_maxdim 
    1373             dim__reorder_xyzt2_c(ji)=TRIM(cd_arr(td_dim(ji)%i_xyzt2)) 
     1468            cf_arr(ji)=TRIM(cd_arr(td_dim(ji)%i_xyzt2)) 
    13741469         ENDDO 
    13751470      ENDIF 
    13761471 
    13771472   END FUNCTION dim__reorder_xyzt2_c 
     1473   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1474   SUBROUTINE dim__clean_unit(td_dim) 
    13781475   !------------------------------------------------------------------- 
    13791476   !> @brief This subroutine clean dimension structure. 
    … …  
    13841481   !> @param[in] td_dim dimension strucutre 
    13851482   !------------------------------------------------------------------- 
    1386    SUBROUTINE dim__clean_unit( td_dim ) 
    1387       IMPLICIT NONE 
     1483 
     1484      IMPLICIT NONE 
     1485 
    13881486      ! Argument 
    13891487      TYPE(TDIM), INTENT(INOUT) :: td_dim 
    … …  
    14001498 
    14011499   END SUBROUTINE dim__clean_unit 
     1500   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1501   SUBROUTINE dim__clean_arr(td_dim) 
    14021502   !------------------------------------------------------------------- 
    14031503   !> @brief This subroutine clean array of dimension structure 
    … …  
    14081508   !> @param[in] td_dim array of dimension strucutre 
    14091509   !------------------------------------------------------------------- 
    1410    SUBROUTINE dim__clean_arr( td_dim ) 
     1510 
    14111511      IMPLICIT NONE 
    14121512      ! Argument 
    … …  
    14221522 
    14231523   END SUBROUTINE dim__clean_arr 
     1524   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1525   SUBROUTINE dim_get_dummy(cd_dummy) 
    14241526   !------------------------------------------------------------------- 
    14251527   !> @brief This subroutine fill dummy dimension array 
    … …  
    14271529   !> @author J.Paul 
    14281530   !> @date September, 2015 - Initial Version 
    1429    ! 
     1531   !> @date May, 2019 
     1532   !> - read number of dummy element 
     1533   !> 
    14301534   !> @param[in] cd_dummy dummy configuration file 
    14311535   !------------------------------------------------------------------- 
    1432    SUBROUTINE dim_get_dummy( cd_dummy ) 
     1536 
    14331537      IMPLICIT NONE 
    14341538      ! Argument 
    … …  
    14431547      ! loop indices 
    14441548      ! namelist 
     1549      INTEGER(i4)                                :: in_ndumvar 
     1550      INTEGER(i4)                                :: in_ndumdim 
     1551      INTEGER(i4)                                :: in_ndumatt 
    14451552      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumvar 
    14461553      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumdim 
    … …  
    14491556      !---------------------------------------------------------------- 
    14501557      NAMELIST /namdum/ &   !< dummy namelist 
     1558      &  in_ndumvar,&       !< number of variable  name 
     1559      &  in_ndumdim,&       !< number of dimension name 
     1560      &  in_ndumatt,&       !< number of attribute name 
    14511561      &  cn_dumvar, &       !< variable  name 
    14521562      &  cn_dumdim, &       !< dimension name 
    … …  
    14751585 
    14761586         READ( il_fileid, NML = namdum ) 
    1477          cm_dumdim(:)=cn_dumdim(:) 
     1587         im_ndumdim  = in_ndumdim 
     1588         cm_dumdim(:)= cn_dumdim(:) 
    14781589 
    14791590         CLOSE( il_fileid ) 
    14801591 
     1592         IF( im_ndumdim > ip_maxdumcfg )THEN 
     1593            CALL logger_fatal("DIM GET dUMMY : too much dummy dimension & 
     1594            &     ( >"//fct_str(ip_maxdumcfg)//" ). & 
     1595            &     set ip_maxdumcfg to higher value.") 
     1596         ENDIF 
    14811597      ENDIF 
    14821598 
    14831599   END SUBROUTINE dim_get_dummy 
     1600   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1601   FUNCTION dim_is_dummy(td_dim) & 
     1602         & RESULT (lf_dummy) 
    14841603   !------------------------------------------------------------------- 
    14851604   !> @brief This function check if dimension is defined as dummy dimension 
    … …  
    14881607   !> @author J.Paul 
    14891608   !> @date September, 2015 - Initial Version 
    1490    ! 
     1609   !> @date, May, 2019 
     1610   !> - use number of dummy elt in do-loop 
     1611   !> 
    14911612   !> @param[in] td_dim dimension structure 
    14921613   !> @return true if dimension is dummy dimension  
    14931614   !------------------------------------------------------------------- 
    1494    FUNCTION dim_is_dummy(td_dim) 
     1615 
    14951616      IMPLICIT NONE 
    14961617 
    … …  
    14991620       
    15001621      ! function 
    1501       LOGICAL :: dim_is_dummy 
     1622      LOGICAL                :: lf_dummy 
    15021623       
    15031624      ! loop indices 
    … …  
    15051626      !---------------------------------------------------------------- 
    15061627 
    1507       dim_is_dummy=.FALSE. 
    1508       DO ji=1,ip_maxdumcfg 
     1628      lf_dummy=.FALSE. 
     1629      DO ji=1,im_ndumdim 
    15091630         IF( fct_lower(td_dim%c_name) == fct_lower(cm_dumdim(ji)) )THEN 
    1510             dim_is_dummy=.TRUE. 
     1631            lf_dummy=.TRUE. 
    15111632            EXIT 
    15121633         ENDIF 
    … …  
    15141635 
    15151636   END FUNCTION dim_is_dummy 
     1637   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1638   SUBROUTINE dim_def_extra(cd_file) 
    15161639   !------------------------------------------------------------------- 
    15171640   !> @brief This subroutine read dimension configuration file,  
    … …  
    15201643   !> @author J.Paul 
    15211644   !> @date Ocotber, 2016 - Initial Version 
     1645   !> @date May, 2019 
     1646   !> - read number of element for each dimention  
    15221647   ! 
    15231648   !> @param[in] cd_file input file (dimension configuration file) 
    15241649   !------------------------------------------------------------------- 
    1525    SUBROUTINE dim_def_extra( cd_file ) 
     1650 
    15261651      IMPLICIT NONE 
    15271652 
    … …  
    15371662      ! loop indices 
    15381663      ! namelist 
     1664      INTEGER(i4)                                :: in_dimX = 0 
     1665      INTEGER(i4)                                :: in_dimY = 0 
     1666      INTEGER(i4)                                :: in_dimZ = 0 
     1667      INTEGER(i4)                                :: in_dimT = 0 
    15391668      CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg) :: cn_dimX = ''  
    15401669      CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg) :: cn_dimY = '' 
    … …  
    15441673      !---------------------------------------------------------------- 
    15451674      NAMELIST /namdim/ &   !< dimension namelist 
     1675      &  in_dimX, &       !< number of x dimension name allowed 
     1676      &  in_dimY, &       !< number of y dimension name allowed 
     1677      &  in_dimZ, &       !< number of z dimension name allowed 
     1678      &  in_dimT, &       !< number of t dimension name allowed 
    15461679      &  cn_dimX, &       !< x dimension name allowed 
    15471680      &  cn_dimY, &       !< y dimension name allowed 
    … …  
    15751708    
    15761709         READ( il_fileid, NML = namdim ) 
     1710         im_dimX   =in_dimX 
     1711         im_dimY   =in_dimY 
     1712         im_dimZ   =in_dimZ 
     1713         im_dimT   =in_dimT 
    15771714         cm_dimX(:)=cn_dimX(:) 
    15781715         cm_dimY(:)=cn_dimY(:) 
    … …  
    15901727 
    15911728   END SUBROUTINE dim_def_extra 
     1729   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1730   FUNCTION dim__is_allowed(cd_name, cd_dim, id_ndim) & 
     1731         & RESULT (lf_allowed) 
    15921732   !------------------------------------------------------------------- 
    15931733   !> @brief This function check if dimension is allowed, i.e defined  
    … …  
    15951735   !> 
    15961736   !> @author J.Paul 
    1597    !> @date OCTOber, 2016 - Initial Version 
     1737   !> @date October, 2016 - Initial Version 
     1738   !> @date May, 2019 
     1739   !> - use number of element for each dimention allowed, instead of while loop  
    15981740   ! 
    15991741   !> @param[in] cd_name dimension name 
    16001742   !> @param[in] cd_dim  array dimension name allowed 
     1743   !> @param[in] id_ndim number of elt in array dimension name allowed 
    16011744   !> @return true if dimension is allowed  
    16021745   !------------------------------------------------------------------- 
    1603    FUNCTION dim__is_allowed(cd_name, cd_dim) 
     1746 
    16041747      IMPLICIT NONE 
    16051748 
    … …  
    16071750      CHARACTER(LEN=*),               INTENT(IN) :: cd_name 
    16081751      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_dim 
     1752      INTEGER(i4)     ,               INTENT(IN) :: id_ndim 
    16091753       
    16101754      ! function 
    1611       LOGICAL :: dim__is_allowed 
     1755      LOGICAL                                    :: lf_allowed 
    16121756       
    16131757      ! loop indices 
    … …  
    16151759      !---------------------------------------------------------------- 
    16161760 
    1617       dim__is_allowed=.FALSE. 
    1618       ji=1 
    1619       DO WHILE( TRIM(cd_dim(ji)) /= '' ) 
     1761      lf_allowed=.FALSE. 
     1762      DO ji=1,id_ndim 
    16201763         IF( TRIM(fct_lower(cd_name)) == TRIM(fct_lower(cd_dim(ji))) )THEN 
    1621             dim__is_allowed=.TRUE. 
     1764            lf_allowed=.TRUE. 
    16221765            EXIT 
    16231766         ENDIF 
    1624          ji=ji+1 
    16251767      ENDDO 
    16261768 
    16271769   END FUNCTION dim__is_allowed 
    1628  
     1770   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    16291771END MODULE dim 
    16301772 
Note: See TracChangeset for help on using the changeset viewer.