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

    r9598 r12080  
    22! NEMO system team, System and Interface for oceanic RElocable Nesting 
    33!---------------------------------------------------------------------- 
    4 ! 
    5 ! MODULE: file 
    64! 
    75!> @brief  
    … …  
    136134!> @author 
    137135!> J.Paul 
    138 ! REVISION HISTORY: 
     136!> 
    139137!> @date November, 2013 - Initial Version 
    140138!> @date November, 2014  
    141139!> - Fix memory leaks bug 
    142140!> 
    143 !> @note Software governed by the CeCILL licence     (./LICENSE) 
     141!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    144142!---------------------------------------------------------------------- 
    145143MODULE file 
     144 
    146145   USE kind                            ! F90 kind parameter 
    147146   USE global                          ! global variable 
    … …  
    151150   USE att                             ! attribute manager 
    152151   USE var                             ! variable manager 
     152 
    153153   IMPLICIT NONE 
    154154   ! NOTE_avoid_public_variables_if_possible 
    … …  
    272272 
    273273CONTAINS 
     274   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     275   FUNCTION file__copy_unit(td_file) & 
     276         & RESULT (tf_file) 
    274277   !------------------------------------------------------------------- 
    275278   !> @brief 
    … …  
    293296   !> - use function instead of overload assignment operator  
    294297   !> (to avoid memory leak) 
    295    ! 
     298   !> @date January, 2019 
     299   !> - clean variable structure 
     300   !>  
    296301   !> @param[in] td_file  file structure 
    297302   !> @return copy of input file structure 
    298303   !------------------------------------------------------------------- 
    299    FUNCTION file__copy_unit( td_file ) 
    300       IMPLICIT NONE 
     304 
     305      IMPLICIT NONE 
     306 
    301307      ! Argument 
    302308      TYPE(TFILE), INTENT(IN) :: td_file 
     309 
    303310      ! function 
    304       TYPE(TFILE) :: file__copy_unit 
     311      TYPE(TFILE)             :: tf_file 
    305312 
    306313      ! local variable 
    … …  
    315322 
    316323      ! copy file variable 
    317       file__copy_unit%c_name = TRIM(td_file%c_name) 
    318       file__copy_unit%c_type = TRIM(td_file%c_type) 
     324      tf_file%c_name = TRIM(td_file%c_name) 
     325      tf_file%c_type = TRIM(td_file%c_type) 
    319326      ! file1 should be closed even if file2 is opened right now 
    320       file__copy_unit%i_id   = 0 
    321       file__copy_unit%l_wrt  = td_file%l_wrt 
    322       file__copy_unit%i_nvar = td_file%i_nvar 
    323  
    324       file__copy_unit%c_grid = td_file%c_grid 
    325  
    326       file__copy_unit%i_ew   = td_file%i_ew 
    327       file__copy_unit%i_perio= td_file%i_perio 
    328       file__copy_unit%i_pivot= td_file%i_pivot 
    329  
    330       file__copy_unit%i_depthid = td_file%i_depthid 
    331       file__copy_unit%i_timeid  = td_file%i_timeid 
     327      tf_file%i_id   = 0 
     328      tf_file%l_wrt  = td_file%l_wrt 
     329      tf_file%i_nvar = td_file%i_nvar 
     330 
     331      tf_file%c_grid = td_file%c_grid 
     332 
     333      tf_file%i_ew   = td_file%i_ew 
     334      tf_file%i_perio= td_file%i_perio 
     335      tf_file%i_pivot= td_file%i_pivot 
     336 
     337      tf_file%i_depthid = td_file%i_depthid 
     338      tf_file%i_timeid  = td_file%i_timeid 
    332339 
    333340      ! copy variable structure 
    334       IF( ASSOCIATED(file__copy_unit%t_var) )THEN 
    335          CALL var_clean(file__copy_unit%t_var(:)) 
    336          DEALLOCATE(file__copy_unit%t_var) 
    337       ENDIF 
    338       IF( ASSOCIATED(td_file%t_var) .AND. file__copy_unit%i_nvar > 0 )THEN 
    339          ALLOCATE( file__copy_unit%t_var(file__copy_unit%i_nvar) ) 
    340          DO ji=1,file__copy_unit%i_nvar 
     341      IF( ASSOCIATED(tf_file%t_var) )THEN 
     342         CALL var_clean(tf_file%t_var(:)) 
     343         DEALLOCATE(tf_file%t_var) 
     344      ENDIF 
     345      IF( ASSOCIATED(td_file%t_var) .AND. tf_file%i_nvar > 0 )THEN 
     346         ALLOCATE( tf_file%t_var(tf_file%i_nvar) ) 
     347         DO ji=1,tf_file%i_nvar 
    341348            tl_var = var_copy(td_file%t_var(ji)) 
    342             file__copy_unit%t_var(ji) = var_copy(tl_var) 
     349            tf_file%t_var(ji) = var_copy(tl_var) 
     350            ! clean 
     351            CALL var_clean(tl_var) 
    343352         ENDDO 
    344353      ENDIF 
    345354       
    346355      ! copy netcdf variable 
    347       file__copy_unit%i_ndim   = td_file%i_ndim 
    348       file__copy_unit%i_natt   = td_file%i_natt 
    349       file__copy_unit%i_uldid  = td_file%i_uldid 
    350       file__copy_unit%l_def    = td_file%l_def 
     356      tf_file%i_ndim   = td_file%i_ndim 
     357      tf_file%i_natt   = td_file%i_natt 
     358      tf_file%i_uldid  = td_file%i_uldid 
     359      tf_file%l_def    = td_file%l_def 
    351360 
    352361      ! copy dimension 
    353       file__copy_unit%t_dim(:) = dim_copy(td_file%t_dim(:)) 
     362      tf_file%t_dim(:) = dim_copy(td_file%t_dim(:)) 
    354363       
    355364      ! copy attribute structure 
    356       IF( ASSOCIATED(file__copy_unit%t_att) )THEN 
    357          CALL att_clean(file__copy_unit%t_att(:)) 
    358          DEALLOCATE(file__copy_unit%t_att) 
    359       ENDIF 
    360       IF( ASSOCIATED(td_file%t_att) .AND. file__copy_unit%i_natt > 0 )THEN 
    361          ALLOCATE( file__copy_unit%t_att(file__copy_unit%i_natt) ) 
    362          DO ji=1,file__copy_unit%i_natt 
     365      IF( ASSOCIATED(tf_file%t_att) )THEN 
     366         CALL att_clean(tf_file%t_att(:)) 
     367         DEALLOCATE(tf_file%t_att) 
     368      ENDIF 
     369      IF( ASSOCIATED(td_file%t_att) .AND. tf_file%i_natt > 0 )THEN 
     370         ALLOCATE( tf_file%t_att(tf_file%i_natt) ) 
     371         DO ji=1,tf_file%i_natt 
    363372            tl_att = att_copy(td_file%t_att(ji)) 
    364             file__copy_unit%t_att(ji) = att_copy(tl_att) 
     373            tf_file%t_att(ji) = att_copy(tl_att) 
    365374         ENDDO 
    366375      ENDIF 
    … …  
    370379 
    371380      ! copy dimg variable 
    372       file__copy_unit%i_recl = td_file%i_recl 
    373       file__copy_unit%i_n0d  = td_file%i_n0d 
    374       file__copy_unit%i_n1d  = td_file%i_n1d 
    375       file__copy_unit%i_n2d  = td_file%i_n2d 
    376       file__copy_unit%i_n3d  = td_file%i_n3d  
    377       file__copy_unit%i_rhd  = td_file%i_rhd 
     381      tf_file%i_recl = td_file%i_recl 
     382      tf_file%i_n0d  = td_file%i_n0d 
     383      tf_file%i_n1d  = td_file%i_n1d 
     384      tf_file%i_n2d  = td_file%i_n2d 
     385      tf_file%i_n3d  = td_file%i_n3d  
     386      tf_file%i_rhd  = td_file%i_rhd 
    378387       
    379388      ! copy mpp variable 
    380       file__copy_unit%i_pid  = td_file%i_pid 
    381       file__copy_unit%i_impp = td_file%i_impp 
    382       file__copy_unit%i_jmpp = td_file%i_jmpp 
    383       file__copy_unit%i_lci  = td_file%i_lci 
    384       file__copy_unit%i_lcj  = td_file%i_lcj 
    385       file__copy_unit%i_ldi  = td_file%i_ldi 
    386       file__copy_unit%i_ldj  = td_file%i_ldj 
    387       file__copy_unit%i_lei  = td_file%i_lei 
    388       file__copy_unit%i_lej  = td_file%i_lej 
    389       file__copy_unit%l_ctr  = td_file%l_ctr 
    390       file__copy_unit%l_use  = td_file%l_use 
    391       file__copy_unit%i_iind = td_file%i_iind 
    392       file__copy_unit%i_jind = td_file%i_jind 
     389      tf_file%i_pid  = td_file%i_pid 
     390      tf_file%i_impp = td_file%i_impp 
     391      tf_file%i_jmpp = td_file%i_jmpp 
     392      tf_file%i_lci  = td_file%i_lci 
     393      tf_file%i_lcj  = td_file%i_lcj 
     394      tf_file%i_ldi  = td_file%i_ldi 
     395      tf_file%i_ldj  = td_file%i_ldj 
     396      tf_file%i_lei  = td_file%i_lei 
     397      tf_file%i_lej  = td_file%i_lej 
     398      tf_file%l_ctr  = td_file%l_ctr 
     399      tf_file%l_use  = td_file%l_use 
     400      tf_file%i_iind = td_file%i_iind 
     401      tf_file%i_jind = td_file%i_jind 
    393402 
    394403   END FUNCTION file__copy_unit 
     404   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     405   FUNCTION file__copy_arr(td_file) & 
     406         & RESULT (tf_file) 
    395407   !------------------------------------------------------------------- 
    396408   !> @brief 
    … …  
    414426   !> - use function instead of overload assignment operator  
    415427   !> (to avoid memory leak) 
    416    ! 
     428   !> 
    417429   !> @param[in] td_file  file structure 
    418430   !> @return copy of input array of file structure 
    419431   !------------------------------------------------------------------- 
    420    FUNCTION file__copy_arr( td_file ) 
    421       IMPLICIT NONE 
     432 
     433      IMPLICIT NONE 
     434 
    422435      ! Argument 
    423       TYPE(TFILE), DIMENSION(:)                , INTENT(IN   ) :: td_file 
     436      TYPE(TFILE), DIMENSION(:), INTENT(IN   ) :: td_file 
     437 
    424438      ! function 
    425       TYPE(TFILE), DIMENSION(SIZE(td_file(:))) :: file__copy_arr 
     439      TYPE(TFILE), DIMENSION(SIZE(td_file(:))) :: tf_file 
    426440 
    427441      ! loop indices 
    … …  
    430444 
    431445      DO ji=1,SIZE(td_file(:)) 
    432          file__copy_arr(ji)=file_copy(td_file(ji)) 
     446         tf_file(ji)=file_copy(td_file(ji)) 
    433447      ENDDO 
    434448 
    435449   END FUNCTION file__copy_arr 
     450   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     451   FUNCTION file_init(cd_file, cd_type, ld_wrt, & 
     452         &                        id_ew, id_perio, id_pivot,& 
     453         &                        cd_grid) & 
     454         & RESULT (tf_file) 
    436455   !------------------------------------------------------------------- 
    437456   !> @brief This function initialize file structure.<br/>  
    … …  
    441460   !> Optionally, you could specify:<br/> 
    442461   !> - write mode (default .FALSE., ld_wrt) 
    443    !% - East-West overlap (id_ew) 
    444    !% - NEMO periodicity index (id_perio) 
    445    !% - NEMO pivot point index F(0),T(1) (id_pivot) 
     462   !> - East-West overlap (id_ew) 
     463   !> - NEMO periodicity index (id_perio) 
     464   !> - NEMO pivot point index F(0),T(1) (id_pivot) 
    446465   !> - grid type (default: 'ARAKAWA-C') 
    447    ! 
     466   !> 
    448467   !> @details 
    449    ! 
     468   !> 
    450469   !> @author J.Paul 
    451470   !> @date November, 2013 - Initial Version 
    452    ! 
     471   !> 
    453472   !> @param[in] cd_file   file name 
    454473   !> @param[in] cd_type   file type ('cdf', 'dimg') 
    … …  
    460479   !> @return file structure 
    461480   !------------------------------------------------------------------- 
    462    TYPE(TFILE) FUNCTION file_init( cd_file, cd_type, ld_wrt, & 
    463    &                               id_ew, id_perio, id_pivot,& 
    464    &                               cd_grid) 
    465       IMPLICIT NONE 
     481 
     482      IMPLICIT NONE 
     483 
    466484      ! Argument       
    467485      CHARACTER(LEN=*), INTENT(IN) :: cd_file 
    … …  
    473491      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_grid 
    474492 
     493      ! function 
     494      TYPE(TFILE)                  :: tf_file 
     495 
    475496      ! local variable 
    476497      TYPE(TATT)  :: tl_att 
    … …  
    478499 
    479500      ! clean file 
    480       CALL file_clean(file_init) 
    481  
    482       file_init%c_name=TRIM(ADJUSTL(cd_file)) 
    483       CALL logger_trace("FILE INIT: initialize file "//TRIM(file_init%c_name)) 
     501      CALL file_clean(tf_file) 
     502 
     503      tf_file%c_name=TRIM(ADJUSTL(cd_file)) 
     504      CALL logger_trace("FILE INIT: initialize file "//TRIM(tf_file%c_name)) 
    484505 
    485506      ! check type 
    … …  
    487508         SELECT CASE(TRIM(cd_type)) 
    488509            CASE('cdf') 
    489                file_init%c_type='cdf' 
     510               tf_file%c_type='cdf' 
    490511            CASE('dimg') 
    491                file_init%c_type='dimg' 
     512               tf_file%c_type='dimg' 
    492513            CASE DEFAULT 
    493514               CALL logger_error( " FILE INIT: can't initialize file "//& 
    494                &               TRIM(file_init%c_name)//" : type unknown " ) 
     515               &               TRIM(tf_file%c_name)//" : type unknown " ) 
    495516         END SELECT 
    496517      ELSE 
    497          file_init%c_type=TRIM(file_get_type(cd_file)) 
     518         CALL logger_debug("FILE INIT: look for file type "//TRIM(tf_file%c_name)) 
     519         tf_file%c_type=TRIM(file_get_type(cd_file)) 
    498520      ENDIF 
    499521 
    500522      ! create some global attribute 
    501       IF( TRIM(file_init%c_type) == 'cdf' )THEN 
     523      IF( TRIM(tf_file%c_type) == 'cdf' )THEN 
    502524         tl_att=att_init("Conventions","CF-1.5") 
    503          CALL file_add_att(file_init,tl_att) 
     525         CALL file_add_att(tf_file,tl_att) 
    504526      ENDIF 
    505527      
    506       tl_att=att_init("Grid",TRIM(file_init%c_grid)) 
    507       CALL file_add_att(file_init,tl_att) 
     528      tl_att=att_init("Grid",TRIM(tf_file%c_grid)) 
     529      CALL file_add_att(tf_file,tl_att) 
    508530 
    509531      IF( PRESENT(ld_wrt) )THEN 
    510          file_init%l_wrt=ld_wrt 
     532         tf_file%l_wrt=ld_wrt 
    511533      ENDIF 
    512534 
    513535      IF( PRESENT(id_ew) )THEN 
    514          file_init%i_ew=id_ew 
     536         tf_file%i_ew=id_ew 
    515537         IF( id_ew >= 0 )THEN 
    516538            tl_att=att_init('ew_overlap',id_ew) 
    517             CALL file_move_att(file_init, tl_att) 
     539            CALL file_move_att(tf_file, tl_att) 
    518540         ENDIF 
    519541      ENDIF 
    520542 
    521543      IF( PRESENT(id_perio) )THEN 
    522          file_init%i_perio=id_perio 
     544         tf_file%i_perio=id_perio 
    523545         IF( id_perio >= 0 )THEN 
    524546            tl_att=att_init('periodicity',id_perio) 
    525             CALL file_move_att(file_init, tl_att) 
     547            CALL file_move_att(tf_file, tl_att) 
    526548         ENDIF 
    527549      ENDIF 
    528550 
    529551      IF( PRESENT(id_pivot) )THEN 
    530          file_init%i_pivot=id_pivot 
     552         tf_file%i_pivot=id_pivot 
    531553         IF( id_pivot > 0 )THEN 
    532554            tl_att=att_init('pivot_point',id_pivot) 
    533             CALL file_move_att(file_init, tl_att) 
     555            CALL file_move_att(tf_file, tl_att) 
    534556         ENDIF 
    535557      ENDIF 
    536558 
    537559      IF( PRESENT(cd_grid) )THEN 
    538          file_init%c_grid=cd_grid 
     560         tf_file%c_grid=cd_grid 
    539561      ENDIF 
    540562 
    … …  
    543565 
    544566   END FUNCTION file_init 
     567   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     568   FUNCTION file_get_type(cd_file) & 
     569         & RESULT (cf_type) 
    545570   !------------------------------------------------------------------- 
    546571   !> @brief  
    … …  
    555580   !> @author J.Paul 
    556581   !> @date November, 2013 - Initial Version 
    557    ! 
     582   !> @date January, 2019 
     583   !> - netcdf4 files identify as netcdf file  
     584   !> 
    558585   !> @param[in] cd_file   file name 
    559586   !> @return type of file 
    560587   !------------------------------------------------------------------- 
    561    CHARACTER(LEN=lc) FUNCTION file_get_type(cd_file) 
    562       IMPLICIT NONE 
     588 
     589      IMPLICIT NONE 
     590 
    563591      ! Argument       
    564592      CHARACTER(LEN=*), INTENT(IN) :: cd_file 
    565593 
     594      ! function 
     595      CHARACTER(LEN=lc)            :: cf_type 
     596 
    566597      !local variable 
    567598      CHARACTER(LEN=lc) :: cl_suffix 
    … …  
    570601      cl_suffix=file__get_suffix(cd_file) 
    571602      SELECT CASE( TRIM(fct_lower(cl_suffix)) ) 
    572          CASE('.nc','.cdf') 
     603         CASE('.nc','.cdf','.nc4') 
    573604            CALL logger_debug(" FILE GET TYPE: file "//TRIM(cd_file)//" is cdf") 
    574             file_get_type='cdf' 
     605            ! Warning : type could be change to cdf4 when opening file. 
     606            cf_type='cdf' 
    575607         CASE('.dimg') 
    576608            CALL logger_debug(" FILE GET TYPE: file "//TRIM(cd_file)//" is dimg" ) 
    577             file_get_type='dimg' 
     609            cf_type='dimg' 
    578610         CASE DEFAULT 
    579611            CALL logger_warn(" FILE GET TYPE: type unknown, we assume file: "//& 
    580612            &              TRIM(cd_file)//" is dimg ") 
    581             file_get_type='dimg' 
     613            cf_type='dimg' 
    582614      END SELECT 
    583615 
    584616   END FUNCTION file_get_type 
    585    !------------------------------------------------------------------- 
    586    !> @brief This function check if variable dimension to be used  
    587    !> have the same length that in file structure. 
     617   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     618   FUNCTION file_check_var_dim(td_file, td_var, ld_chklen) & 
     619         & RESULT (lf_dim) 
     620   !------------------------------------------------------------------- 
     621   !> @brief This function check that variable dimension to be used  
     622   !> of both variable and file structure are convenient (axis, length). 
    588623   ! 
    589624   !> @details 
     625   !> optionaly you could choose to not check length 
    590626   ! 
    591627   !> @author J.Paul 
    592628   !> @date November, 2013 - Initial Version 
     629   !> @date September, 2017 
     630   !> - add option to not check dimension length 
    593631   ! 
    594632   !> @param[in] td_file   file structure 
    595633   !> @param[in] td_var    variable structure 
     634   !> @param[in] ld_chklen check length 
    596635   !> @return true if dimension of variable and file structure agree 
    597636   !------------------------------------------------------------------- 
    598    LOGICAL FUNCTION file_check_var_dim(td_file, td_var) 
    599       IMPLICIT NONE 
     637 
     638      IMPLICIT NONE 
     639 
    600640      ! Argument       
    601641      TYPE(TFILE), INTENT(IN) :: td_file 
    602642      TYPE(TVAR),  INTENT(IN) :: td_var 
     643      LOGICAL,     INTENT(IN), OPTIONAL :: ld_chklen 
     644 
     645      ! function 
     646      LOGICAL                 :: lf_dim 
    603647 
    604648      ! local variable 
    … …  
    606650      LOGICAL           :: ll_error 
    607651      LOGICAL           :: ll_warn  
     652      LOGICAL           :: ll_chklen 
     653      LOGICAL           :: ll_use 
     654      LOGICAL           :: ll_len 
    608655 
    609656      INTEGER(i4)       :: il_ind 
    … …  
    612659      INTEGER(i4) :: ji 
    613660      !---------------------------------------------------------------- 
    614       file_check_var_dim=.TRUE. 
     661 
     662      lf_dim=.TRUE. 
     663 
     664      CALL logger_debug( " FILE CHECK VAR DIM: check: "//TRIM(td_var%c_name) ) 
     665      ! check dimension length 
     666      ll_chklen=.TRUE. 
     667      IF( PRESENT(ld_chklen) ) ll_chklen=ld_chklen 
    615668 
    616669      ! check used dimension  
    … …  
    621674         &                     TRIM(td_var%t_dim(ji)%c_name), & 
    622675         &                     TRIM(td_var%t_dim(ji)%c_sname)) 
     676 
    623677         IF( il_ind /= 0 )THEN 
    624             IF( td_var%t_dim(ji)%l_use  .AND. & 
    625             &   td_file%t_dim(il_ind)%l_use .AND. & 
    626             &   td_var%t_dim(ji)%i_len /= td_file%t_dim(il_ind)%i_len )THEN 
     678            ll_use=(td_var%t_dim(ji)%l_use .AND. td_file%t_dim(il_ind)%l_use) 
     679 
     680            ll_len=.TRUE. 
     681            IF( ll_chklen )THEN 
     682               ! check dimension length 
     683               ll_len=(td_var%t_dim(ji)%i_len == td_file%t_dim(il_ind)%i_len) 
     684            ENDIF 
     685            IF( ll_use .AND. .NOT. ll_len )THEN 
    627686               IF( INDEX( TRIM(td_var%c_axis), & 
    628687               &          TRIM(fct_upper(td_var%t_dim(ji)%c_name))) == 0 )THEN 
    … …  
    659718         CALL logger_debug( " variable dimension: "//TRIM(cl_dim) ) 
    660719 
    661          file_check_var_dim=.FALSE. 
     720         lf_dim=.FALSE. 
    662721 
    663722         CALL logger_error( & 
    … …  
    683742 
    684743   END FUNCTION file_check_var_dim 
     744   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     745   SUBROUTINE file_add_var(td_file, td_var) 
    685746   !------------------------------------------------------------------- 
    686747   !> @brief This subroutine add a variable structure in a file structure.<br/> 
    … …  
    698759   !> @date September, 2015 
    699760   !> - check variable dimension expected 
    700    ! 
     761   !> @date January, 2019 
     762   !> - clean variable structure 
     763   !> 
    701764   !> @param[inout] td_file   file structure 
    702765   !> @param[in] td_var       variable structure 
    703766   !------------------------------------------------------------------- 
    704    SUBROUTINE file_add_var(td_file, td_var) 
     767 
    705768      IMPLICIT NONE 
    706769 
    … …  
    831894                        ! clean 
    832895                        CALL var_clean(tl_var(:)) 
    833                         DEALLOCATE(tl_var) 
    834896                     ENDIF 
     897                     DEALLOCATE(tl_var) 
    835898 
    836899                  ELSE 
    … …  
    861924                  ELSE 
    862925                     tl_var(1)=var_copy(td_var) 
     926                     ! remove old id 
     927                     tl_var(1)%i_id=0 
    863928 
    864929                     ! update dimension name in new variable 
    … …  
    897962                     ! clean 
    898963                     CALL var_clean( tl_var(:) ) 
    899                      DEALLOCATE(tl_var) 
    900964                  ENDIF 
     965                  DEALLOCATE(tl_var) 
     966 
    901967               ENDIF 
    902968            ENDIF 
    … …  
    905971 
    906972   END SUBROUTINE file_add_var 
     973   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     974   SUBROUTINE file__del_var_name(td_file, cd_name) 
    907975   !------------------------------------------------------------------- 
    908976   !> @brief This subroutine delete a variable structure  
    909977   !> in file structure, given variable name or standard name. 
    910    ! 
     978   !> 
    911979   !> @author J.Paul 
    912980   !> @date November, 2013 - Initial Version 
    913981   !> @date February, 2015  
    914982   !> - define local variable structure to avoid mistake with pointer 
    915    ! 
     983   !> 
    916984   !> @param[inout] td_file   file structure 
    917985   !> @param[in] cd_name      variable name or standard name 
    918986   !------------------------------------------------------------------- 
    919    SUBROUTINE file__del_var_name(td_file, cd_name ) 
     987 
    920988      IMPLICIT NONE 
    921989 
    … …  
    9501018               tl_var=var_copy(td_file%t_var(il_ind)) 
    9511019               CALL file_del_var(td_file, tl_var) 
    952  
     1020               ! clean 
     1021               CALL var_clean(tl_var) 
    9531022            ELSE 
    9541023 
    … …  
    9691038 
    9701039   END SUBROUTINE file__del_var_name 
     1040   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1041   SUBROUTINE file__del_var_str(td_file, td_var) 
    9711042   !------------------------------------------------------------------- 
    9721043   !> @brief This subroutine delete a variable structure  
    … …  
    9751046   !> @author J.Paul 
    9761047   !> @date November, 2013 - Initial Version 
     1048   !> @date January, 2019 
     1049   !> - clean variable structure 
    9771050   !> 
    9781051   !> @param[inout] td_file   file structure 
    9791052   !> @param[in] td_var       variable structure 
    9801053   !------------------------------------------------------------------- 
    981    SUBROUTINE file__del_var_str(td_file, td_var) 
     1054 
    9821055      IMPLICIT NONE 
    9831056 
    … …  
    11011174                  ! clean 
    11021175                  CALL var_clean(tl_var(:)) 
    1103                   DEALLOCATE(tl_var) 
    1104                    
    11051176               ENDIF  
     1177               DEALLOCATE(tl_var) 
     1178 
    11061179            ENDIF 
    11071180         ENDIF 
    … …  
    11091182 
    11101183   END SUBROUTINE file__del_var_str 
     1184   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1185   SUBROUTINE file_move_var(td_file, td_var) 
    11111186   !------------------------------------------------------------------- 
    11121187   !> @brief This subroutine overwrite variable structure  
    … …  
    11211196   !> @param[in] td_var       variable structure 
    11221197   !------------------------------------------------------------------- 
    1123    SUBROUTINE file_move_var(td_file, td_var) 
     1198 
    11241199      IMPLICIT NONE 
    11251200 
    … …  
    11451220 
    11461221   END SUBROUTINE file_move_var 
     1222   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1223   SUBROUTINE file_add_att(td_file, td_att) 
    11471224   !------------------------------------------------------------------- 
    11481225   !> @brief This subroutine add a global attribute  
    … …  
    11521229   !> @author J.Paul 
    11531230   !> @date November, 2013 - Initial Version 
    1154    ! 
     1231   !> @date January, 2019 
     1232   !> - clean attribute structure 
     1233   !> 
    11551234   !> @param[inout] td_file   file structure 
    11561235   !> @param[in] td_att       attribute structure 
    11571236   !------------------------------------------------------------------- 
    1158    SUBROUTINE file_add_att(td_file, td_att) 
     1237 
    11591238      IMPLICIT NONE 
    11601239 
    … …  
    12341313                   ! clean 
    12351314                  CALL att_clean(tl_att(:)) 
    1236                   DEALLOCATE(tl_att) 
    1237  
    12381315               ENDIF 
     1316               DEALLOCATE(tl_att) 
     1317 
    12391318            ELSE 
    12401319            ! no attribute in file structure 
    … …  
    12621341 
    12631342   END SUBROUTINE file_add_att 
     1343   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1344   SUBROUTINE file__del_att_name(td_file, cd_name) 
    12641345   !------------------------------------------------------------------- 
    12651346   !> @brief This subroutine delete a global attribute structure  
    12661347   !> in file structure, given attribute name. 
    1267    ! 
     1348   !> 
    12681349   !> @author J.Paul 
    12691350   !> @date November, 2013 - Initial Version 
    … …  
    12711352   !> - define local attribute structure to avoid mistake 
    12721353   !> with pointer 
    1273    ! 
     1354   !> @date January, 2019 
     1355   !> - clean attribute structure 
     1356   !> 
    12741357   !> @param[inout] td_file   file structure 
    12751358   !> @param[in] cd_name      attribute name 
    12761359   !------------------------------------------------------------------- 
    1277    SUBROUTINE file__del_att_name(td_file, cd_name ) 
     1360 
    12781361      IMPLICIT NONE 
    12791362 
    … …  
    13081391               tl_att=att_copy(td_file%t_att(il_ind)) 
    13091392               CALL file_del_att(td_file, tl_att) 
    1310  
     1393               ! clean 
     1394               CALL att_clean(tl_att) 
    13111395            ELSE 
    13121396 
    … …  
    13251409 
    13261410   END SUBROUTINE file__del_att_name 
     1411   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1412   SUBROUTINE file__del_att_str(td_file, td_att) 
    13271413   !------------------------------------------------------------------- 
    13281414   !> @brief This subroutine delete a global attribute structure  
    13291415   !> from file structure, given attribute structure. 
    1330    ! 
     1416   !> 
    13311417   !> @author J.Paul 
    13321418   !> @date November, 2013 - Initial Version 
    1333    ! 
     1419   !> @date January, 2019 
     1420   !> - clean attribute structure 
     1421   !> 
    13341422   !> @param[inout] td_file   file structure 
    13351423   !> @param[in] td_att       attribute structure 
    13361424   !------------------------------------------------------------------- 
    1337    SUBROUTINE file__del_att_str(td_file, td_att) 
     1425 
    13381426      IMPLICIT NONE 
    13391427 
    … …  
    14151503               ! clean  
    14161504               CALL att_clean(tl_att(:)) 
    1417                DEALLOCATE(tl_att) 
    1418  
    14191505            ENDIF  
     1506            DEALLOCATE(tl_att) 
     1507 
    14201508         ENDIF 
    14211509      ENDIF 
    14221510 
    14231511   END SUBROUTINE file__del_att_str 
     1512   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1513   SUBROUTINE file_move_att(td_file, td_att) 
    14241514   !------------------------------------------------------------------- 
    14251515   !> @brief This subroutine move a global attribute structure  
    14261516   !> from file structure. 
    14271517   !> @warning change attribute id in file structure. 
    1428    ! 
     1518   !> 
    14291519   !> @author J.Paul 
    14301520   !> @date November, 2013 - Initial Version 
    1431    ! 
     1521   !> 
    14321522   !> @param[inout] td_file   file structure 
    14331523   !> @param[in] td_att       attribute structure 
    14341524   !------------------------------------------------------------------- 
    1435    SUBROUTINE file_move_att(td_file, td_att) 
     1525 
    14361526      IMPLICIT NONE 
    14371527 
    … …  
    14631553 
    14641554   END SUBROUTINE file_move_att 
     1555   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1556   SUBROUTINE file_add_dim(td_file, td_dim) 
    14651557   !------------------------------------------------------------------- 
    14661558   !> @brief This subroutine add a dimension structure in file  
    14671559   !> structure. 
    14681560   !> Do not overwrite, if dimension already in file structure. 
    1469    ! 
     1561   !> 
    14701562   !> @author J.Paul 
    14711563   !> @date November, 2013 - Initial Version 
    14721564   !> @date September, 2014 
    14731565   !> - do not reorder dimension, before put in file 
    1474    ! 
     1566   !> 
    14751567   !> @param[inout] td_file   file structure 
    14761568   !> @param[in] td_dim       dimension structure 
    14771569   !------------------------------------------------------------------- 
    1478    SUBROUTINE file_add_dim(td_file, td_dim) 
     1570 
    14791571      IMPLICIT NONE 
    14801572 
    … …  
    15491641 
    15501642   END SUBROUTINE file_add_dim 
     1643   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1644   SUBROUTINE file_del_dim(td_file, td_dim) 
    15511645   !------------------------------------------------------------------- 
    15521646   !> @brief This subroutine delete a dimension structure in file  
    … …  
    15551649   !> @author J.Paul 
    15561650   !> @date November, 2013 - Initial Version 
    1557    ! 
     1651   !> @date January, 2019 
     1652   !> - clean dimension structure 
     1653   !> 
    15581654   !> @param[inout] td_file   file structure 
    15591655   !> @param[in] td_dim       dimension structure 
    15601656   !------------------------------------------------------------------- 
    1561    SUBROUTINE file_del_dim(td_file, td_dim) 
     1657 
    15621658      IMPLICIT NONE 
    15631659 
    … …  
    16221718               ! clean 
    16231719               CALL dim_clean(tl_dim(:)) 
    1624                DEALLOCATE(tl_dim) 
    16251720            ENDIF 
     1721            DEALLOCATE(tl_dim) 
     1722 
    16261723         ENDIF 
    16271724      ENDIF 
    16281725 
    16291726   END SUBROUTINE file_del_dim 
     1727   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1728   SUBROUTINE file_move_dim(td_file, td_dim) 
    16301729   !------------------------------------------------------------------- 
    16311730   !> @brief This subroutine move a dimension structure  
    16321731   !> in file structure. 
    16331732   !> @warning change dimension order in file structure.  
    1634    ! 
     1733   !> 
    16351734   !> @author J.Paul 
    16361735   !> @date November, 2013 - Initial Version 
    1637    ! 
     1736   !> 
    16381737   !> @param[inout] td_file   file structure 
    16391738   !> @param[in] td_dim       dimension structure 
    16401739   !------------------------------------------------------------------- 
    1641    SUBROUTINE file_move_dim(td_file, td_dim) 
     1740 
    16421741      IMPLICIT NONE 
    16431742 
    … …  
    16731772 
    16741773   END SUBROUTINE file_move_dim 
     1774   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1775   SUBROUTINE file_print(td_file) 
    16751776   !------------------------------------------------------------------- 
    16761777   !> @brief This subroutine print some information about file strucutre. 
    1677    ! 
     1778   !> 
    16781779   !> @author J.Paul 
    16791780   !> @date November, 2013 - Initial Version 
    1680    ! 
     1781   !> 
    16811782   !> @param[in] td_file   file structure 
    16821783   !------------------------------------------------------------------- 
    1683    SUBROUTINE file_print(td_file) 
     1784 
    16841785      IMPLICIT NONE 
    16851786 
    … …  
    17471848 
    17481849   END SUBROUTINE file_print 
     1850   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1851   FUNCTION file__get_suffix(cd_file) & 
     1852         & RESULT (cf_suffix) 
    17491853   !------------------------------------------------------------------- 
    17501854   !> @brief This function get suffix of file name. 
    … …  
    17531857   !> last '.' in file name.<br/> 
    17541858   !> If no suffix is found, return empty character. 
    1755    ! 
     1859   !> 
    17561860   !> @author J.Paul 
    17571861   !> @date November, 2013 - Initial Version 
    1758    ! 
     1862   !> 
    17591863   !> @param[in] cd_file   file structure 
    17601864   !> @return suffix 
    17611865   !------------------------------------------------------------------- 
    1762    CHARACTER(LEN=lc) FUNCTION file__get_suffix(cd_file) 
     1866 
    17631867      IMPLICIT NONE 
    17641868 
    … …  
    17661870      CHARACTER(LEN=*), INTENT(IN) :: cd_file 
    17671871 
     1872      ! function 
     1873      CHARACTER(LEN=lc)            :: cf_suffix 
     1874    
    17681875      ! local variable 
    17691876      INTEGER(i4) :: il_ind 
    … …  
    17761883      IF( il_ind /= 0 )THEN 
    17771884         ! read number in basename 
    1778          READ( cd_file(il_ind:),'(a)' ) file__get_suffix 
    1779  
    1780          IF( fct_is_num(file__get_suffix(2:)) )THEN 
    1781             file__get_suffix='' 
     1885         READ( cd_file(il_ind:),'(a)' ) cf_suffix 
     1886 
     1887         IF( fct_is_num(cf_suffix(2:)) )THEN 
     1888            cf_suffix='' 
    17821889         ENDIF 
    17831890 
    17841891      ELSE 
    1785          file__get_suffix='' 
     1892         cf_suffix='' 
    17861893      ENDIF 
    17871894 
    17881895   END FUNCTION file__get_suffix 
     1896   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1897   FUNCTION file__get_number(cd_file) & 
     1898         & RESULT (cf_number) 
    17891899   !------------------------------------------------------------------- 
    17901900   !> @brief This function get number in file name without suffix. 
    … …  
    17921902   !> Actually it get the number following the last separator. 
    17931903   !> separator could be '.' or '_'. 
    1794    ! 
     1904   !> 
    17951905   !> @author J.Paul 
    17961906   !> @date November, 2013 - Initial Version 
    … …  
    18001910   !> - add case to not return release number 
    18011911   !> we assume release number only on one digit (ex : file_v3.5.nc) 
    1802    ! 
     1912   !> 
    18031913   !> @param[in] cd_file   file name (without suffix) 
    18041914   !> @return character file number. 
    18051915   !------------------------------------------------------------------- 
    1806    CHARACTER(LEN=lc) FUNCTION file__get_number(cd_file) 
     1916 
    18071917      IMPLICIT NONE 
    18081918 
    18091919      ! Argument       
    18101920      CHARACTER(LEN=lc), INTENT(IN) :: cd_file 
     1921 
     1922      ! function 
     1923      CHARACTER(LEN=lc)             :: cf_number 
    18111924 
    18121925      ! local variable 
    … …  
    18291942      IF( il_indmax /= 0 )THEN 
    18301943         ! read number in basename 
    1831          READ( cd_file(il_indmax:),'(a)' ) file__get_number 
    1832  
    1833          IF( .NOT. fct_is_num(file__get_number(2:)) )THEN 
    1834             file__get_number='' 
    1835          ELSEIF( LEN(TRIM(file__get_number))-1 == 8 )THEN 
     1944         READ( cd_file(il_indmax:),'(a)' ) cf_number 
     1945 
     1946         IF( .NOT. fct_is_num(cf_number(2:)) )THEN 
     1947            cf_number='' 
     1948         ELSEIF( LEN(TRIM(cf_number))-1 == 8 )THEN 
    18361949            ! date case yyyymmdd 
    1837             file__get_number='' 
    1838          ELSEIF( LEN(TRIM(file__get_number))-1 == 1 )THEN 
     1950            cf_number='' 
     1951         ELSEIF( LEN(TRIM(cf_number))-1 == 1 )THEN 
    18391952            ! release number case  
    1840             file__get_number='' 
     1953            cf_number='' 
    18411954         ENDIF 
    18421955      ELSE 
    1843          file__get_number='' 
     1956         cf_number='' 
    18441957      ENDIF 
    18451958 
    18461959   END FUNCTION file__get_number 
     1960   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1961   FUNCTION file__rename_char(cd_file, id_num) & 
     1962         & RESULT (cf_file) 
    18471963   !------------------------------------------------------------------- 
    18481964   !> @brief This function rename file name, given processor number. 
    … …  
    18501966   !> If no processor number is given, return file name without number 
    18511967   !> If processor number is given, return file name with new number 
    1852    ! 
     1968   !> 
    18531969   !> @author J.Paul 
    18541970   !> @date November, 2013 - Initial Version 
    1855    ! 
     1971   !> 
    18561972   !> @param[in] td_file   file structure 
    18571973   !> @param[in] id_num    processor number (start to 1) 
    18581974   !> @return file name 
    18591975   !------------------------------------------------------------------- 
    1860    CHARACTER(LEN=lc) FUNCTION file__rename_char(cd_file, id_num) 
     1976 
    18611977      IMPLICIT NONE 
    18621978 
    … …  
    18641980      CHARACTER(LEN=*), INTENT(IN) :: cd_file 
    18651981      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_num 
     1982 
     1983      ! function 
     1984      CHARACTER(LEN=lc)            :: cf_file 
    18661985 
    18671986      ! local variable 
    … …  
    19012020         ! format 
    19022021         WRITE(cl_format,'(a,i1.1,a,i1.1,a)') '(a,a,i',il_numlen,'.',il_numlen,',a)' 
    1903          WRITE(file__rename_char,cl_format) TRIM(cl_base),TRIM(cl_sep),id_num,TRIM(cl_suffix) 
     2022         WRITE(cf_file,cl_format) TRIM(cl_base),TRIM(cl_sep),id_num,TRIM(cl_suffix) 
    19042023      ELSE 
    1905          WRITE(file__rename_char,'(a,a)') TRIM(cl_base),TRIM(cl_suffix) 
    1906       ENDIF 
    1907       CALL logger_trace(" FILE RENAME : "//TRIM(file__rename_char)) 
     2024         WRITE(cf_file,'(a,a)') TRIM(cl_base),TRIM(cl_suffix) 
     2025      ENDIF 
     2026      CALL logger_trace(" FILE RENAME : "//TRIM(cf_file)) 
    19082027 
    19092028   END FUNCTION file__rename_char 
     2029   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     2030   FUNCTION file__rename_str(td_file, id_num) & 
     2031         & RESULT (tf_file) 
    19102032   !------------------------------------------------------------------- 
    19112033   !> @brief This function rename file name, given file structure. 
    … …  
    19132035   !> If no processor number is given, return file name without number 
    19142036   !> I processor number is given, return file name with new number 
    1915    ! 
     2037   !> 
    19162038   !> @author J.Paul 
    19172039   !> @date November, 2013 - Initial Version 
    1918    ! 
     2040   !> 
    19192041   !> @param[in] td_file   file structure 
    19202042   !> @param[in] id_num    processor number (start to 1) 
    19212043   !> @return file structure 
    19222044   !------------------------------------------------------------------- 
    1923    TYPE(TFILE) FUNCTION file__rename_str(td_file, id_num) 
     2045 
    19242046      IMPLICIT NONE 
    19252047 
    … …  
    19282050      INTEGER(i4), INTENT(IN), OPTIONAL :: id_num 
    19292051 
     2052      ! function 
     2053      TYPE(TFILE)             :: tf_file 
     2054 
    19302055      ! local variable 
    19312056      CHARACTER(LEN=lc) :: cl_name 
    … …  
    19352060      cl_name=TRIM( file_rename(td_file%c_name, id_num) ) 
    19362061 
    1937       file__rename_str=file_init(TRIM(cl_name), TRIM(td_file%c_type)) 
     2062      tf_file=file_init(TRIM(cl_name), TRIM(td_file%c_type)) 
    19382063 
    19392064   END FUNCTION file__rename_str 
     2065   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     2066   FUNCTION file_add_suffix(cd_file, cd_type) & 
     2067         & RESULT (cf_file) 
    19402068   !------------------------------------------------------------------- 
    19412069   !> @brief This function add suffix to file name. 
    1942    ! 
     2070   !> 
    19432071   !> @author J.Paul 
    19442072   !> @date November, 2013 - Initial Version 
    1945    ! 
     2073   !> 
    19462074   !> @param[in] td_file   file structure 
    19472075   !> @return file name 
    19482076   !------------------------------------------------------------------- 
    1949    CHARACTER(LEN=lc) FUNCTION file_add_suffix(cd_file, cd_type) 
     2077 
    19502078      IMPLICIT NONE 
    19512079 
    … …  
    19542082      CHARACTER(LEN=*), INTENT(IN) :: cd_type 
    19552083 
     2084      ! function 
     2085      CHARACTER(LEN=lc)            :: cf_file 
     2086 
    19562087      ! local variable 
    19572088      INTEGER(i4)       :: il_ind 
    … …  
    19592090      CHARACTER(LEN=lc) :: cl_suffix 
    19602091      !---------------------------------------------------------------- 
     2092 
    19612093      ! get suffix  
    19622094      cl_suffix=file__get_suffix(cd_file) 
    … …  
    19702102      SELECT CASE(TRIM(cd_type)) 
    19712103         CASE('cdf') 
    1972             file_add_suffix=TRIM(cl_file)//'.nc' 
     2104            cf_file=TRIM(cl_file)//TRIM(cl_suffix) 
    19732105         CASE('dimg') 
    19742106            IF( TRIM(cl_suffix) /= '' )THEN 
    1975                file_add_suffix=TRIM(cl_file)//'.dimg' 
     2107               cf_file=TRIM(cl_file)//'.dimg' 
    19762108            ELSE 
    1977                file_add_suffix=TRIM(cl_file) 
     2109               cf_file=TRIM(cl_file) 
    19782110            ENDIF 
    19792111         CASE DEFAULT 
    … …  
    19822114 
    19832115   END FUNCTION file_add_suffix 
     2116   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     2117   SUBROUTINE file__clean_unit(td_file) 
    19842118   !------------------------------------------------------------------- 
    19852119   !> @brief  
    19862120   !>  This subroutine clean file strcuture. 
    1987    ! 
     2121   !> 
    19882122   !> @author J.Paul 
    19892123   !> @date November, 2013 - Inital version 
    1990    ! 
     2124   !> @date January, 2019 
     2125   !> - nullify attribute structure inside file structure 
     2126   !> - nullify variable structure inside file structure 
     2127   !> 
    19912128   !> @param[inout] td_file   file strcuture 
    19922129   !------------------------------------------------------------------- 
    1993    SUBROUTINE file__clean_unit( td_file ) 
    1994       IMPLICIT NONE 
     2130 
     2131      IMPLICIT NONE 
     2132 
    19952133      ! Argument 
    19962134      TYPE(TFILE),  INTENT(INOUT) :: td_file 
    … …  
    20092147         CALL att_clean( td_file%t_att(:) ) 
    20102148         DEALLOCATE(td_file%t_att) 
     2149         NULLIFY(td_file%t_att) 
    20112150      ENDIF 
    20122151 
    … …  
    20202159         CALL var_clean( td_file%t_var(:) ) 
    20212160         DEALLOCATE(td_file%t_var) 
     2161         NULLIFY(td_file%t_var) 
    20222162      ENDIF 
    20232163 
    … …  
    20262166 
    20272167   END SUBROUTINE file__clean_unit 
     2168   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     2169   SUBROUTINE file__clean_arr(td_file) 
    20282170   !------------------------------------------------------------------- 
    20292171   !> @brief  
    20302172   !>  This subroutine clean file array of file strcuture. 
    2031    ! 
     2173   !> 
    20322174   !> @author J.Paul 
    20332175   !> @date Marsh, 2014 - Inital version 
    2034    ! 
     2176   !> 
    20352177   !> @param[inout] td_file   array file strcuture 
    20362178   !------------------------------------------------------------------- 
    2037    SUBROUTINE file__clean_arr( td_file ) 
    2038       IMPLICIT NONE 
     2179 
     2180      IMPLICIT NONE 
     2181 
    20392182      ! Argument 
    20402183      TYPE(TFILE), DIMENSION(:), INTENT(INOUT) :: td_file 
    … …  
    20502193 
    20512194   END SUBROUTINE file__clean_arr 
     2195   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     2196   FUNCTION file_get_id(td_file, cd_name) & 
     2197         & RESULT (if_id) 
    20522198   !------------------------------------------------------------------- 
    20532199   !> @brief This function return the file id, in a array of file 
    20542200   !> structure,  given file name.  
    2055    ! 
     2201   !> 
    20562202   !> @author J.Paul 
    20572203   !> @date November, 2013 - Initial Version 
    2058    ! 
     2204   !> 
    20592205   !> @param[in] td_file   array of file structure 
    20602206   !> @param[in] cd_name   file name 
    20612207   !> @return file id in array of file structure (0 if not found) 
    20622208   !------------------------------------------------------------------- 
    2063    INTEGER(i4) FUNCTION file_get_id(td_file, cd_name) 
    2064       IMPLICIT NONE 
     2209 
     2210      IMPLICIT NONE 
     2211 
    20652212      ! Argument       
    20662213      TYPE(TFILE)     , DIMENSION(:), INTENT(IN) :: td_file 
    20672214      CHARACTER(LEN=*),               INTENT(IN) :: cd_name 
    20682215 
     2216      ! function 
     2217      INTEGER(i4)                                :: if_id 
     2218 
    20692219      ! local variable 
    20702220      INTEGER(i4) :: il_size 
    … …  
    20732223      INTEGER(i4) :: ji 
    20742224      !---------------------------------------------------------------- 
    2075       file_get_id=0 
     2225      if_id=0 
    20762226      il_size=SIZE(td_file(:)) 
    20772227 
    … …  
    20812231         IF( fct_lower(td_file(ji)%c_name) == fct_lower(cd_name) )THEN 
    20822232          
    2083             file_get_id=td_file(ji)%i_id 
     2233            if_id=td_file(ji)%i_id 
    20842234            EXIT 
    20852235 
    … …  
    20882238 
    20892239   END FUNCTION file_get_id 
     2240   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     2241   FUNCTION file_get_unit(td_file) & 
     2242         & RESULT (if_unit) 
    20902243   !------------------------------------------------------------------- 
    20912244   !> @brief 
    … …  
    20942247   !> @author J.Paul 
    20952248   !> @date September, 2014 - Initial Version 
    2096    ! 
     2249   !> 
    20972250   !> @param[in] td_file   array of file  
    20982251   !------------------------------------------------------------------- 
    2099    FUNCTION file_get_unit(td_file) 
    2100       IMPLICIT NONE 
     2252 
     2253      IMPLICIT NONE 
     2254 
    21012255      ! Argument 
    21022256      TYPE(TFILE), DIMENSION(:), INTENT(IN   ) :: td_file 
    21032257 
    21042258      ! function 
    2105       INTEGER(i4) :: file_get_unit 
     2259      INTEGER(i4)                              :: if_unit 
    21062260 
    21072261      ! local variable 
    … …  
    21092263      !---------------------------------------------------------------- 
    21102264 
    2111       file_get_unit=MAXVAL(td_file(:)%i_id)+1 
     2265      if_unit=MAXVAL(td_file(:)%i_id)+1 
    21122266 
    21132267   END FUNCTION file_get_unit 
     2268   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    21142269END MODULE file 
    21152270 
Note: See TracChangeset for help on using the changeset viewer.