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 5965 for branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/TOOLS/SIREN/src/multi.f90 – NEMO

Ignore:
Timestamp:
2015-12-01T16:35:30+01:00 (8 years ago)
Author:
timgraham
Message:

Upgraded branch to r5518 of trunk (v3.6 stable revision)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/TOOLS/SIREN/src/multi.f90

    r4213 r5965  
    55! MODULE: multi 
    66! 
    7 ! 
    87! DESCRIPTION: 
    9 !> This module manage multi file structure 
     8!> This module manage multi file structure. 
    109! 
    1110!> @details 
    12 !> define type TMULTI:<br/> 
    13 !> TYPE(TMULTI) :: tl_multi<br/> 
     11!>    define type TMULTI:<br/> 
     12!> @code 
     13!>    TYPE(TMULTI) :: tl_multi 
     14!> @endcode 
     15!> 
     16!>    to initialize a multi-file structure:<br/> 
     17!> @code 
     18!>    tl_multi=multi_init(cd_varfile(:)) 
     19!> @endcode 
     20!>       - cd_varfile : array of variable with file path  
     21!>       ('var1:file1','var2:file2')<br/> 
     22!>          file path could be replaced by a matrix of value.<br/> 
     23!>          separators used to defined matrix are: 
     24!>             - ',' for line 
     25!>             - '/' for row 
     26!>             - '\' for level<br/> 
     27!>             Example:<br/> 
     28!>                - 'var1:3,2,3/1,4,5' 
     29!>                - 3,2,3/1,4,5  =>   
     30!>                      @f$ \left( \begin{array}{ccc} 
     31!>                           3 & 2 & 3 \\ 
     32!>                           1 & 4 & 5 \end{array} \right) @f$<br/> 
     33!>  
     34!>    to get the number of mpp file in mutli file structure:<br/> 
     35!>    - tl_multi\%i_nmpp 
     36!> 
     37!>    to get the total number of variable in mutli file structure:<br/> 
     38!>    - tl_multi\%i_nvar 
     39!> 
     40!>    @note number of variable and number of file could differ cause several variable 
     41!>    could be in the same file. 
     42!> 
     43!>    to get array of mpp structure in mutli file structure:<br/> 
     44!>    - tl_multi\%t_mpp(:) 
     45!> 
     46!>    to print information about multi structure:<br/> 
     47!> @code 
     48!>    CALL multi_print(td_multi) 
     49!> @endcode 
     50!> 
     51!>    to clean multi file strucutre:<br/> 
     52!> @code 
     53!>    CALL multi_clean(td_multi) 
     54!> @endcode 
     55!>       - td_multi is multi file structure 
    1456!> 
    1557!> @author 
    1658!>  J.Paul 
    1759! REVISION HISTORY: 
    18 !> @date 2013 - Initial Version 
     60!> @date November, 2013 - Initial Version 
     61!> @date October, 2014 
     62!> - use mpp file structure instead of file 
     63!> @date November, 2014 - Fix memory leaks bug 
    1964! 
    2065!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    2267MODULE multi 
    2368   USE kind                            ! F90 kind parameter 
    24    USE logger                             ! log file manager 
     69   USE logger                          ! log file manager 
    2570   USE fct                             ! basic useful function 
    2671   USE dim                             ! dimension manager 
    27    USE att                             ! attribute manager 
    2872   USE var                             ! variable manager 
    2973   USE file                            ! file manager 
     74   USE iom                             ! I/O manager 
     75   USE mpp                             ! MPP manager 
     76   USE iom_mpp                         ! MPP I/O manager 
     77 
    3078   IMPLICIT NONE 
    31    PRIVATE 
    3279   ! NOTE_avoid_public_variables_if_possible 
    3380 
    3481   ! type and variable 
    35    PUBLIC :: TMULTI       ! multi file structure 
     82   PUBLIC :: TMULTI       !< multi file structure 
    3683 
    3784   ! function and subroutine 
    38    PUBLIC :: ASSIGNMENT(=)     !< copy multi structure 
    39    PUBLIC :: multi_init        !< initialise mpp structure 
    40    PUBLIC :: multi_clean       !< clean mpp strcuture 
    41    PUBLIC :: multi_print       !< print information about mpp structure 
    42  
    43    PUBLIC :: multi_add_file    !< add one proc strucutre in mpp structure 
    44 !   PUBLIC :: multi_del_file    !< delete one proc strucutre in mpp structure 
    45 !   PUBLIC :: multi_move_file   !< overwrite proc strucutre in mpp structure 
    46  
    47    !> @struct TMULTI 
    48    TYPE TMULTI 
     85   PUBLIC :: multi_copy        !< copy multi structure 
     86   PUBLIC :: multi_init        !< initialise multi structure 
     87   PUBLIC :: multi_clean       !< clean multi strcuture 
     88   PUBLIC :: multi_print       !< print information about milti structure 
     89 
     90   PUBLIC :: multi__add_mpp    !< add file strucutre to multi file structure 
     91   PRIVATE :: multi__copy_unit !< copy multi file structure 
     92 
     93   TYPE TMULTI !< multi file structure 
    4994      ! general  
    50       INTEGER(i4)                         :: i_nfile = 0         !< number of files  
     95      INTEGER(i4)                         :: i_nmpp  = 0         !< number of mpp files  
    5196      INTEGER(i4)                         :: i_nvar  = 0         !< total number of variables 
    52       TYPE(TFILE), DIMENSION(:), POINTER  :: t_file => NULL()    !< files composing multi 
     97      TYPE(TMPP) , DIMENSION(:), POINTER  :: t_mpp => NULL()     !< mpp files composing multi 
    5398   END TYPE 
    5499 
    55    INTERFACE ASSIGNMENT(=) 
    56       MODULE PROCEDURE multi__copy   ! copy multi file structure 
     100   INTERFACE multi_copy 
     101      MODULE PROCEDURE multi__copy_unit   ! copy multi file structure 
    57102   END INTERFACE    
    58103 
     
    60105   !------------------------------------------------------------------- 
    61106   !> @brief 
    62    !> This function copy multi file structure in another multi file 
    63    !> structure 
     107   !> This function copy multi mpp structure in another one 
    64108   !> @details  
    65    !> file variable value are copied in a temporary table,  
     109   !> file variable value are copied in a temporary array,  
    66110   !> so input and output file structure value do not point on the same  
    67111   !> "memory cell", and so on are independant.  
    68112   !> 
     113   !> @warning do not use on the output of a function who create or read an 
     114   !> attribute (ex: tl_att=att_copy(att_init()) is forbidden). 
     115   !> This will create memory leaks. 
    69116   !> @warning to avoid infinite loop, do not use any function inside  
    70117   !> this subroutine 
    71118   !>    
    72119   !> @author J.Paul 
    73    !> - Nov, 2013- Initial Version 
    74    ! 
    75    !> @param[out] td_multi1  : file structure 
    76    !> @param[in] td_multi2  : file structure 
    77    !------------------------------------------------------------------- 
    78    !> @code 
    79    SUBROUTINE multi__copy( td_multi1, td_multi2 ) 
     120   !> - November, 2013- Initial Version 
     121   !> @date November, 2014 
     122   !>    - use function instead of overload assignment operator (to avoid memory leak) 
     123   !> 
     124   !> @param[in] td_multi    mpp structure 
     125   !> @return copy of input multi structure 
     126   !------------------------------------------------------------------- 
     127   FUNCTION multi__copy_unit( td_multi ) 
    80128      IMPLICIT NONE 
    81129      ! Argument 
    82       TYPE(TMULTI), INTENT(OUT) :: td_multi1 
    83       TYPE(TMULTI), INTENT(IN)  :: td_multi2 
     130      TYPE(TMULTI), INTENT(IN)  :: td_multi 
     131      ! function 
     132      TYPE(TMULTI) :: multi__copy_unit 
     133 
     134      ! local variable 
     135      TYPE(TMPP) :: tl_mpp 
    84136 
    85137      ! loop indices 
     
    87139      !---------------------------------------------------------------- 
    88140 
    89       CALL logger_trace("COPY: mulit file ") 
    90  
    91       td_multi1%i_nfile = td_multi2%i_nfile 
    92       td_multi1%i_nvar  = td_multi2%i_nvar 
     141      multi__copy_unit%i_nmpp = td_multi%i_nmpp 
     142      multi__copy_unit%i_nvar = td_multi%i_nvar 
    93143 
    94144      ! copy variable structure 
    95       IF( ASSOCIATED(td_multi1%t_file) ) DEALLOCATE(td_multi1%t_file) 
    96       IF( ASSOCIATED(td_multi2%t_file) .AND. td_multi1%i_nfile > 0 )THEN 
    97          ALLOCATE( td_multi1%t_file(td_multi1%i_nfile) ) 
    98          DO ji=1,td_multi1%i_nfile 
    99             td_multi1%t_file(ji) = td_multi2%t_file(ji) 
     145      IF( ASSOCIATED(multi__copy_unit%t_mpp) )THEN 
     146         CALL mpp_clean(multi__copy_unit%t_mpp(:)) 
     147         DEALLOCATE(multi__copy_unit%t_mpp) 
     148      ENDIF 
     149      IF( ASSOCIATED(td_multi%t_mpp) .AND. multi__copy_unit%i_nmpp > 0 )THEN 
     150         ALLOCATE( multi__copy_unit%t_mpp(multi__copy_unit%i_nmpp) ) 
     151         DO ji=1,multi__copy_unit%i_nmpp 
     152            tl_mpp = mpp_copy(td_multi%t_mpp(ji)) 
     153            multi__copy_unit%t_mpp(ji) = mpp_copy(tl_mpp) 
    100154         ENDDO 
    101       ENDIF 
    102  
    103    END SUBROUTINE multi__copy 
    104    !> @endcode 
     155         ! clean 
     156         CALL mpp_clean(tl_mpp) 
     157      ENDIF 
     158 
     159   END FUNCTION multi__copy_unit 
    105160   !------------------------------------------------------------------- 
    106161   !> @brief This subroutine initialize multi file structure. 
    107    ! 
     162   !> 
     163   !> @details 
     164   !> if variable name is 'all', add all the variable of the file in mutli file 
     165   !> structure. 
     166   !> @note if first character of filename is numeric, assume matrix is given as 
     167   !> input.<br/> 
     168   !> create pseudo file named 'data-*', with matrix read as variable value. 
     169   !> 
    108170   !> @author J.Paul 
    109    !> - Nov, 2013- Initial Version 
    110    ! 
    111    !> @param[in] cd_varfile : variable location information (from namelist)  
    112    !> @return td_multi : multi structure 
    113    !------------------------------------------------------------------- 
    114    ! @code 
     171   !> - November, 2013- Initial Version 
     172   !> 
     173   !> @param[in] cd_varfile   variable location information (from namelist)  
     174   !> @return multi file structure 
     175   !------------------------------------------------------------------- 
    115176   FUNCTION multi_init(cd_varfile) 
    116177      IMPLICIT NONE 
     
    124185      ! local variable 
    125186      CHARACTER(LEN=lc) :: cl_name 
     187      CHARACTER(LEN=lc) :: cl_lower 
    126188      CHARACTER(LEN=lc) :: cl_file 
    127189      CHARACTER(LEN=lc) :: cl_matrix 
    128190 
    129       INTEGER(i4)       :: il_fileid 
     191      INTEGER(i4)       :: il_nvar 
     192 
     193      LOGICAL           :: ll_dim 
    130194 
    131195      TYPE(TVAR)        :: tl_var 
    132196 
    133       TYPE(TFILE)       :: tl_file 
    134  
    135       TYPE(TMULTI)      :: tl_multi 
     197      TYPE(TMPP)        :: tl_mpp 
    136198 
    137199      ! loop indices 
    138200      INTEGER(i4) :: ji 
     201      INTEGER(i4) :: jj 
     202      INTEGER(i4) :: jk 
    139203      !---------------------------------------------------------------- 
    140204 
     
    142206      DO WHILE( TRIM(cd_varfile(ji)) /= '' ) 
    143207 
    144          cl_name=fct_lower(fct_split(cd_varfile(ji),1,':')) 
     208         il_nvar=0 
     209         cl_name=fct_split(cd_varfile(ji),1,':') 
     210         cl_lower=fct_lower(cl_name) 
    145211         cl_file=fct_split(cd_varfile(ji),2,':') 
    146212 
    147          IF( TRIM(cl_name) /= '' )THEN 
     213         IF( LEN(TRIM(cl_file)) == lc )THEN 
     214            CALL logger_fatal("MULTI INIT: file name too long (==256)."//& 
     215            &  " check namelist.") 
     216         ENDIF 
     217 
     218         IF( TRIM(cl_lower) /= '' )THEN 
    148219            IF( TRIM(cl_file) /= '' )THEN 
    149220               cl_matrix='' 
    150221               IF( fct_is_num(cl_file(1:1)) )THEN 
    151222                  cl_matrix=TRIM(cl_file) 
    152                   WRITE(cl_file,'(a,i2.2)')'data_',ji 
     223                  WRITE(cl_file,'(a,i2.2)')'data-',ji 
     224 
     225                  tl_var=var_init(TRIM(cl_name)) 
     226                  CALL var_read_matrix(tl_var, cl_matrix) 
     227 
     228                  ! create mpp structure 
     229                  tl_mpp=mpp_init(TRIM(cl_file), tl_var) 
     230 
     231                  ! add variable 
     232                  CALL mpp_add_var(tl_mpp,tl_var) 
     233 
     234                  ! number of variable 
     235                  il_nvar=il_nvar+1 
     236 
     237               ELSE 
     238 
     239                  !  
     240                  tl_mpp=mpp_init( file_init(TRIM(cl_file)) ) 
     241 
     242                  ! define variable 
     243                  IF( TRIM(fct_lower(cl_lower)) /= 'all' )THEN 
     244 
     245                     ! clean var 
     246                     CALL mpp_del_var(tl_mpp) 
     247 
     248                     tl_var=var_init(TRIM(cl_lower)) 
     249 
     250                     ! add variable 
     251                     CALL mpp_add_var(tl_mpp,tl_var) 
     252 
     253                     ! number of variable 
     254                     il_nvar=il_nvar+1 
     255 
     256                     ! clean structure 
     257                     CALL var_clean(tl_var) 
     258 
     259                  ELSE ! cl_lower == 'all' 
     260 
     261                     DO jk=tl_mpp%t_proc(1)%i_nvar,1,-1 
     262                         
     263                        ! check if variable is dimension 
     264                        ll_dim=.FALSE. 
     265                        DO jj=1,ip_maxdim 
     266                           IF( TRIM(tl_mpp%t_proc(1)%t_dim(jj)%c_name) == & 
     267                           &   TRIM(tl_mpp%t_proc(1)%t_var(jk)%c_name) )THEN 
     268                              ll_dim=.TRUE. 
     269                              CALL logger_trace("MULTI INIT: "//& 
     270                              &  TRIM(tl_mpp%t_proc(1)%t_var(jk)%c_name)//& 
     271                              &  ' is var dimension') 
     272                              EXIT 
     273                           ENDIF 
     274                        ENDDO 
     275                        ! do not use variable dimension 
     276                        IF( ll_dim )THEN 
     277                           tl_var=var_init( & 
     278                           &  TRIM(tl_mpp%t_proc(1)%t_var(jk)%c_name) ) 
     279                           ! delete variable 
     280                           CALL mpp_del_var(tl_mpp,tl_var) 
     281                           ! clean structure 
     282                           CALL var_clean(tl_var) 
     283                        ELSE 
     284                           ! number of variable 
     285                           il_nvar=il_nvar+1 
     286                        ENDIF 
     287 
     288                     ENDDO 
     289 
     290                  ENDIF 
     291 
    153292               ENDIF 
    154                 
    155                ! get file id 
    156                tl_file=file_init(TRIM(cl_file)) 
    157                il_fileid=multi_add_file(tl_multi,tl_file)  
    158   
    159                ! define variable 
    160                tl_var=var_init(TRIM(cl_name)) 
    161                CALL var_read_matrix(tl_var, cl_matrix) 
    162  
    163                ! add variable 
    164                CALL file_add_var(tl_multi%t_file(il_fileid),tl_var) 
     293 
     294               CALL multi__add_mpp(multi_init, tl_mpp)  
    165295 
    166296               ! update total number of variable 
    167                tl_multi%i_nvar=tl_multi%i_nvar+1 
    168  
    169                ! clean structure 
    170                CALL var_clean(tl_var) 
     297               multi_init%i_nvar=multi_init%i_nvar+il_nvar 
     298 
     299               ! clean 
     300               CALL mpp_clean(tl_mpp) 
    171301 
    172302            ELSE 
     
    182312      ENDDO 
    183313 
    184       ! save result 
    185       multi_init=tl_multi 
    186  
    187314   END FUNCTION multi_init 
    188    ! @endcode 
    189315   !------------------------------------------------------------------- 
    190316   !> @brief This subroutine clean multi file strucutre. 
    191317   ! 
    192318   !> @author J.Paul 
    193    !> - Nov, 2013- Initial Version 
    194    ! 
    195    !> @param[in] td_multi : multi file structure 
    196    !------------------------------------------------------------------- 
    197    ! @code 
     319   !> - November, 2013- Initial Version 
     320   ! 
     321   !> @param[in] td_multi  multi file structure 
     322   !------------------------------------------------------------------- 
    198323   SUBROUTINE multi_clean(td_multi) 
    199324      IMPLICIT NONE 
     
    206331 
    207332      ! loop indices 
    208       INTEGER(i4) :: ji 
    209333      !---------------------------------------------------------------- 
    210334 
    211335      CALL logger_info( " CLEAN: reset multi file " ) 
    212336 
    213       IF( ASSOCIATED( td_multi%t_file ) )THEN 
    214          DO ji=td_multi%i_nfile,1,-1 
    215             CALL file_clean(td_multi%t_file(ji)) 
    216          ENDDO 
    217          DEALLOCATE(td_multi%t_file) 
     337      IF( ASSOCIATED( td_multi%t_mpp ) )THEN 
     338         CALL mpp_clean(td_multi%t_mpp(:)) 
     339         DEALLOCATE(td_multi%t_mpp) 
    218340      ENDIF 
    219341 
    220342      ! replace by empty structure 
    221       td_multi=tl_multi 
     343      td_multi=multi_copy(tl_multi) 
    222344 
    223345   END SUBROUTINE multi_clean 
    224    ! @endcode 
    225346   !------------------------------------------------------------------- 
    226347   !> @brief This subroutine print some information about mpp strucutre. 
    227348   ! 
    228349   !> @author J.Paul 
    229    !> - Nov, 2013- Initial Version 
    230    ! 
    231    !> @param[in] td_mpp : mpp structure 
    232    !------------------------------------------------------------------- 
    233    ! @code 
     350   !> - November, 2013- Initial Version 
     351   ! 
     352   !> @param[in] td_multi multi file structure 
     353   !------------------------------------------------------------------- 
    234354   SUBROUTINE multi_print(td_multi) 
    235355      IMPLICIT NONE 
     
    246366 
    247367      ! print file 
    248       IF( td_multi%i_nfile /= 0 .AND. ASSOCIATED(td_multi%t_file) )THEN 
    249          WRITE(*,'(/a,i3)') 'MULTI: total number of file: ',& 
    250          &  td_multi%i_nfile 
     368      IF( td_multi%i_nmpp /= 0 .AND. ASSOCIATED(td_multi%t_mpp) )THEN 
     369         WRITE(*,'(/a,i3)') 'MULTI: total number of mpp: ',& 
     370         &  td_multi%i_nmpp 
    251371         WRITE(*,'(6x,a,i3)') ' total number of variable: ',& 
    252372         &  td_multi%i_nvar 
    253          DO ji=1,td_multi%i_nfile 
    254             WRITE(*,'(3x,3a)') 'FILE ',TRIM(td_multi%t_file(ji)%c_name),& 
     373         DO ji=1,td_multi%i_nmpp 
     374            WRITE(*,'(3x,3a)') 'MPP FILE ',TRIM(td_multi%t_mpp(ji)%c_name),& 
    255375            & ' CONTAINS' 
    256             DO jj=1,td_multi%t_file(ji)%i_nvar 
    257                IF( ASSOCIATED(td_multi%t_file(ji)%t_var) )THEN 
    258                   WRITE(*,'(6x,a/)') TRIM(td_multi%t_file(ji)%t_var(jj)%c_name) 
     376            DO jj=1,td_multi%t_mpp(ji)%t_proc(1)%i_nvar 
     377               IF( ASSOCIATED(td_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN 
     378                  WRITE(*,'(6x,a)') & 
     379                  &  TRIM(td_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 
    259380               ENDIF 
    260381            ENDDO 
     
    263384 
    264385   END SUBROUTINE multi_print 
    265    ! @endcode 
    266386   !------------------------------------------------------------------- 
    267387   !> @brief 
     
    271391   ! 
    272392   !> @author J.Paul 
    273    !> - Nov, 2013- Initial Version 
    274    ! 
    275    !> @param[inout] td_multi : multi file strcuture 
    276    !> @param[in]    td_file  : file strcuture 
    277    !> @return file id in multi structure 
    278    !------------------------------------------------------------------- 
    279    !> @code 
    280    FUNCTION multi_add_file( td_multi, td_file ) 
     393   !> - November, 2013- Initial Version 
     394   !> @date October, 2014 
     395   !> - use mpp file structure instead of file 
     396   ! 
     397   !> @param[inout] td_multi  multi mpp file strcuture 
     398   !> @param[in]    td_mpp    mpp file strcuture 
     399   !> @return mpp file id in multi mpp file structure 
     400   !------------------------------------------------------------------- 
     401   SUBROUTINE multi__add_mpp( td_multi, td_mpp ) 
    281402      IMPLICIT NONE 
    282403      ! Argument 
    283404      TYPE(TMULTI), INTENT(INOUT) :: td_multi 
    284       TYPE(TFILE) , INTENT(IN)    :: td_file 
    285  
    286       ! function 
    287       INTEGER(i4) :: multi_add_file 
     405      TYPE(TMPP)  , INTENT(IN)    :: td_mpp 
    288406 
    289407      ! local variable 
    290408      INTEGER(i4) :: il_status 
    291       INTEGER(i4) :: il_fileid 
    292       TYPE(TFILE), DIMENSION(:), ALLOCATABLE :: tl_file 
     409      INTEGER(i4) :: il_mppid 
     410       
     411      TYPE(TMPP), DIMENSION(:), ALLOCATABLE :: tl_mpp 
     412 
     413      ! loop indices 
     414      INTEGER(i4) :: ji 
    293415      !---------------------------------------------------------------- 
    294416 
    295       il_fileid=0 
    296       IF( ASSOCIATED(td_multi%t_file) )THEN 
    297          il_fileid=file_get_id(td_multi%t_file(:),TRIM(td_file%c_name)) 
    298       ENDIF 
    299  
    300       IF( il_fileid /= 0 )THEN 
    301  
    302             multi_add_file=il_fileid 
     417      il_mppid=0 
     418      IF( ASSOCIATED(td_multi%t_mpp) )THEN 
     419         il_mppid=mpp_get_index(td_multi%t_mpp(:),TRIM(td_mpp%c_name)) 
     420      ENDIF 
     421 
     422      IF( il_mppid /= 0 )THEN 
     423 
     424            CALL logger_debug( " MULTI ADD FILE: mpp file "//TRIM(td_mpp%c_name)//& 
     425            &               " already in multi mpp file structure") 
     426 
     427            ! add new variable 
     428            DO ji=1,td_mpp%t_proc(1)%i_nvar 
     429               CALL mpp_add_var(td_multi%t_mpp(il_mppid), td_mpp%t_proc(1)%t_var(ji)) 
     430            ENDDO 
    303431 
    304432      ELSE 
    305           
    306          CALL logger_trace("MULTI ADD FILE: add file "//& 
    307          &               TRIM(td_file%c_name)//" in multi structure") 
    308  
    309          IF( td_multi%i_nfile > 0 )THEN 
     433  
     434         CALL logger_trace("MULTI ADD MPP: add mpp "//& 
     435         &               TRIM(td_mpp%c_name)//" in multi mpp file structure") 
     436 
     437         IF( td_multi%i_nmpp > 0 )THEN 
    310438            !  
    311             ! already other file in multi structure 
    312             ALLOCATE( tl_file(td_multi%i_nfile), stat=il_status ) 
     439            ! already other mpp file in multi file structure 
     440            ALLOCATE( tl_mpp(td_multi%i_nmpp), stat=il_status ) 
    313441            IF(il_status /= 0 )THEN 
    314442 
    315                CALL logger_error( " MULTI ADD FILE: not enough space to put file & 
    316                &               in multi structure") 
     443               CALL logger_error( " MULTI ADD MPP FILE: not enough space to put & 
     444               &               mpp file in multi mpp file structure") 
    317445 
    318446            ELSE 
    319                ! save temporary multi structure 
    320                tl_file(:)=td_multi%t_file(:) 
    321  
    322                DEALLOCATE( td_multi%t_file ) 
    323                ALLOCATE( td_multi%t_file(td_multi%i_nfile+1), stat=il_status) 
     447               ! save temporary multi file structure 
     448               tl_mpp(:)=mpp_copy(td_multi%t_mpp(:)) 
     449 
     450               CALL mpp_clean(td_multi%t_mpp(:)) 
     451               DEALLOCATE( td_multi%t_mpp ) 
     452               ALLOCATE( td_multi%t_mpp(td_multi%i_nmpp+1), stat=il_status) 
    324453               IF(il_status /= 0 )THEN 
    325454 
    326                   CALL logger_error( " MULTI ADD FILE: not enough space to put "//& 
    327                   &  "file in multi structure ") 
     455                  CALL logger_error( " MULTI ADD MPP FILE: not enough space "//& 
     456                  &  "to put mpp file in multi mpp file structure ") 
    328457 
    329458               ENDIF 
    330459 
    331                ! copy file in multi before 
    332                td_multi%t_file(1:td_multi%i_nfile) = tl_file(:) 
    333  
    334                DEALLOCATE(tl_file) 
     460               ! copy mpp file in multi mpp file before 
     461               td_multi%t_mpp(1:td_multi%i_nmpp) = mpp_copy(tl_mpp(:)) 
     462 
     463               ! clean 
     464               CALL mpp_clean(tl_mpp(:)) 
     465               DEALLOCATE(tl_mpp) 
    335466            ENDIF 
    336467 
    337468         ELSE 
    338             ! no processor in mpp structure 
    339             IF( ASSOCIATED(td_multi%t_file) )THEN 
    340                DEALLOCATE(td_multi%t_file) 
     469            ! no file in multi file structure 
     470            IF( ASSOCIATED(td_multi%t_mpp) )THEN 
     471               CALL mpp_clean(td_multi%t_mpp(:)) 
     472               DEALLOCATE(td_multi%t_mpp) 
    341473            ENDIF 
    342             ALLOCATE( td_multi%t_file(td_multi%i_nfile+1), stat=il_status ) 
     474            ALLOCATE( td_multi%t_mpp(td_multi%i_nmpp+1), stat=il_status ) 
    343475            IF(il_status /= 0 )THEN 
    344476 
    345                CALL logger_error( " MULTI ADD FILE: not enough space to put "//& 
    346                &  "file in multi structure " ) 
     477               CALL logger_error( " MULTI ADD MPP FILE: not enough space "//& 
     478               &  "to put mpp file in multi mpp file structure " ) 
    347479 
    348480            ENDIF 
    349481         ENDIF 
    350482 
    351          td_multi%i_nfile=td_multi%i_nfile+1 
    352  
    353          ! add new file 
    354          td_multi%t_file(td_multi%i_nfile)=td_file 
    355  
    356          multi_add_file=td_multi%i_nfile 
    357  
    358       ENDIF 
    359    END FUNCTION multi_add_file 
    360    !> @endcode 
     483         ! update number of mpp 
     484         td_multi%i_nmpp=td_multi%i_nmpp+1 
     485 
     486         ! add new mpp 
     487         td_multi%t_mpp(td_multi%i_nmpp)=mpp_copy(td_mpp) 
     488 
     489      ENDIF 
     490   END SUBROUTINE multi__add_mpp 
    361491END MODULE multi 
    362492 
Note: See TracChangeset for help on using the changeset viewer.