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 6225 for branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/TOOLS/SIREN/src/multi.f90 – NEMO

Ignore:
Timestamp:
2016-01-08T10:35:19+01:00 (8 years ago)
Author:
jamesharle
Message:

Update MPP_BDY_UPDATE branch to be consistent with head of trunk

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/TOOLS/SIREN/src/multi.f90

    r4213 r6225  
    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  
     64!> - Fix memory leaks bug 
    1965! 
    2066!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    2268MODULE multi 
    2369   USE kind                            ! F90 kind parameter 
    24    USE logger                             ! log file manager 
     70   USE logger                          ! log file manager 
    2571   USE fct                             ! basic useful function 
    2672   USE dim                             ! dimension manager 
    27    USE att                             ! attribute manager 
    2873   USE var                             ! variable manager 
    2974   USE file                            ! file manager 
     75   USE iom                             ! I/O manager 
     76   USE mpp                             ! MPP manager 
     77   USE iom_mpp                         ! MPP I/O manager 
     78 
    3079   IMPLICIT NONE 
    31    PRIVATE 
    3280   ! NOTE_avoid_public_variables_if_possible 
    3381 
    3482   ! type and variable 
    35    PUBLIC :: TMULTI       ! multi file structure 
     83   PUBLIC :: TMULTI       !< multi file structure 
    3684 
    3785   ! 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 
     86   PUBLIC :: multi_copy        !< copy multi structure 
     87   PUBLIC :: multi_init        !< initialise multi structure 
     88   PUBLIC :: multi_clean       !< clean multi strcuture 
     89   PUBLIC :: multi_print       !< print information about milti structure 
     90 
     91   PUBLIC :: multi__add_mpp    !< add file strucutre to multi file structure 
     92   PRIVATE :: multi__copy_unit !< copy multi file structure 
     93 
     94   TYPE TMULTI !< multi file structure 
    4995      ! general  
    50       INTEGER(i4)                         :: i_nfile = 0         !< number of files  
     96      INTEGER(i4)                         :: i_nmpp  = 0         !< number of mpp files  
    5197      INTEGER(i4)                         :: i_nvar  = 0         !< total number of variables 
    52       TYPE(TFILE), DIMENSION(:), POINTER  :: t_file => NULL()    !< files composing multi 
     98      TYPE(TMPP) , DIMENSION(:), POINTER  :: t_mpp => NULL()     !< mpp files composing multi 
    5399   END TYPE 
    54100 
    55    INTERFACE ASSIGNMENT(=) 
    56       MODULE PROCEDURE multi__copy   ! copy multi file structure 
     101   INTERFACE multi_copy 
     102      MODULE PROCEDURE multi__copy_unit   ! copy multi file structure 
    57103   END INTERFACE    
    58104 
    … …  
    60106   !------------------------------------------------------------------- 
    61107   !> @brief 
    62    !> This function copy multi file structure in another multi file 
    63    !> structure 
     108   !> This function copy multi mpp structure in another one 
    64109   !> @details  
    65    !> file variable value are copied in a temporary table,  
     110   !> file variable value are copied in a temporary array,  
    66111   !> so input and output file structure value do not point on the same  
    67112   !> "memory cell", and so on are independant.  
    68113   !> 
     114   !> @warning do not use on the output of a function who create or read an 
     115   !> attribute (ex: tl_att=att_copy(att_init()) is forbidden). 
     116   !> This will create memory leaks. 
    69117   !> @warning to avoid infinite loop, do not use any function inside  
    70118   !> this subroutine 
    71119   !>    
    72120   !> @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 ) 
     121   !> @date November, 2013 - Initial Version 
     122   !> @date November, 2014 
     123   !>    - use function instead of overload assignment operator (to avoid memory leak) 
     124   !> 
     125   !> @param[in] td_multi    mpp structure 
     126   !> @return copy of input multi structure 
     127   !------------------------------------------------------------------- 
     128   FUNCTION multi__copy_unit( td_multi ) 
    80129      IMPLICIT NONE 
    81130      ! Argument 
    82       TYPE(TMULTI), INTENT(OUT) :: td_multi1 
    83       TYPE(TMULTI), INTENT(IN)  :: td_multi2 
     131      TYPE(TMULTI), INTENT(IN)  :: td_multi 
     132      ! function 
     133      TYPE(TMULTI) :: multi__copy_unit 
     134 
     135      ! local variable 
     136      TYPE(TMPP) :: tl_mpp 
    84137 
    85138      ! loop indices 
    … …  
    87140      !---------------------------------------------------------------- 
    88141 
    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 
     142      multi__copy_unit%i_nmpp = td_multi%i_nmpp 
     143      multi__copy_unit%i_nvar = td_multi%i_nvar 
    93144 
    94145      ! 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) 
     146      IF( ASSOCIATED(multi__copy_unit%t_mpp) )THEN 
     147         CALL mpp_clean(multi__copy_unit%t_mpp(:)) 
     148         DEALLOCATE(multi__copy_unit%t_mpp) 
     149      ENDIF 
     150      IF( ASSOCIATED(td_multi%t_mpp) .AND. multi__copy_unit%i_nmpp > 0 )THEN 
     151         ALLOCATE( multi__copy_unit%t_mpp(multi__copy_unit%i_nmpp) ) 
     152         DO ji=1,multi__copy_unit%i_nmpp 
     153            tl_mpp = mpp_copy(td_multi%t_mpp(ji)) 
     154            multi__copy_unit%t_mpp(ji) = mpp_copy(tl_mpp) 
    100155         ENDDO 
     156         ! clean 
     157         CALL mpp_clean(tl_mpp) 
    101158      ENDIF 
    102159 
    103    END SUBROUTINE multi__copy 
    104    !> @endcode 
     160   END FUNCTION multi__copy_unit 
    105161   !------------------------------------------------------------------- 
    106162   !> @brief This subroutine initialize multi file structure. 
    107    ! 
     163   !> 
     164   !> @details 
     165   !> if variable name is 'all', add all the variable of the file in mutli file 
     166   !> structure. 
     167   !> @note if first character of filename is numeric, assume matrix is given as 
     168   !> input.<br/> 
     169   !> create pseudo file named 'data-*', with matrix read as variable value. 
     170   !> 
    108171   !> @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 
     172   !> @date November, 2013 - Initial Version 
     173   !> @date July, 2015  
     174   !> - check if variable to be read is in file 
     175   !> 
     176   !> @param[in] cd_varfile   variable location information (from namelist)  
     177   !> @return multi file structure 
     178   !------------------------------------------------------------------- 
    115179   FUNCTION multi_init(cd_varfile) 
    116180      IMPLICIT NONE 
    … …  
    124188      ! local variable 
    125189      CHARACTER(LEN=lc) :: cl_name 
     190      CHARACTER(LEN=lc) :: cl_lower 
    126191      CHARACTER(LEN=lc) :: cl_file 
    127192      CHARACTER(LEN=lc) :: cl_matrix 
    128193 
    129       INTEGER(i4)       :: il_fileid 
     194      INTEGER(i4)       :: il_nvar 
     195      INTEGER(i4)       :: il_varid 
     196 
     197      LOGICAL           :: ll_dim 
    130198 
    131199      TYPE(TVAR)        :: tl_var 
    132200 
    133       TYPE(TFILE)       :: tl_file 
    134  
    135       TYPE(TMULTI)      :: tl_multi 
     201      TYPE(TMPP)        :: tl_mpp 
    136202 
    137203      ! loop indices 
    138204      INTEGER(i4) :: ji 
     205      INTEGER(i4) :: jj 
     206      INTEGER(i4) :: jk 
    139207      !---------------------------------------------------------------- 
    140208 
    … …  
    142210      DO WHILE( TRIM(cd_varfile(ji)) /= '' ) 
    143211 
    144          cl_name=fct_lower(fct_split(cd_varfile(ji),1,':')) 
     212         il_nvar=0 
     213         cl_name=fct_split(cd_varfile(ji),1,':') 
     214         cl_lower=fct_lower(cl_name) 
    145215         cl_file=fct_split(cd_varfile(ji),2,':') 
    146216 
    147          IF( TRIM(cl_name) /= '' )THEN 
     217         IF( LEN(TRIM(cl_file)) == lc )THEN 
     218            CALL logger_fatal("MULTI INIT: file name too long (==256)."//& 
     219            &  " check namelist.") 
     220         ENDIF 
     221 
     222         IF( TRIM(cl_lower) /= '' )THEN 
    148223            IF( TRIM(cl_file) /= '' )THEN 
    149224               cl_matrix='' 
    150225               IF( fct_is_num(cl_file(1:1)) )THEN 
    151226                  cl_matrix=TRIM(cl_file) 
    152                   WRITE(cl_file,'(a,i2.2)')'data_',ji 
     227                  WRITE(cl_file,'(a,i2.2)')'data-',ji 
     228 
     229                  tl_var=var_init(TRIM(cl_name)) 
     230                  CALL var_read_matrix(tl_var, cl_matrix) 
     231 
     232                  ! create mpp structure 
     233                  tl_mpp=mpp_init(TRIM(cl_file), tl_var) 
     234 
     235                  ! add variable 
     236                  CALL mpp_add_var(tl_mpp,tl_var) 
     237 
     238                  ! number of variable 
     239                  il_nvar=il_nvar+1 
     240 
     241               ELSE 
     242 
     243                  !  
     244                  tl_mpp=mpp_init( file_init(TRIM(cl_file)) ) 
     245 
     246                  ! define variable 
     247                  IF( TRIM(fct_lower(cl_lower)) /= 'all' )THEN 
     248 
     249                     ! check if variable is in file 
     250                     il_varid=var_get_index(tl_mpp%t_proc(1)%t_var(:),cl_lower) 
     251                     IF( il_varid == 0 )THEN 
     252                        CALL logger_fatal("MULTI INIT: variable "//& 
     253                           & TRIM(cl_name)//" not in file "//& 
     254                           & TRIM(cl_file) ) 
     255                     ENDIF 
     256 
     257                     ! clean var 
     258                     CALL mpp_del_var(tl_mpp) 
     259 
     260                     tl_var=var_init(TRIM(cl_lower)) 
     261 
     262                     ! add variable 
     263                     CALL mpp_add_var(tl_mpp,tl_var) 
     264 
     265                     ! number of variable 
     266                     il_nvar=il_nvar+1 
     267 
     268                     ! clean structure 
     269                     CALL var_clean(tl_var) 
     270 
     271                  ELSE ! cl_lower == 'all' 
     272 
     273                     DO jk=tl_mpp%t_proc(1)%i_nvar,1,-1 
     274                         
     275                        ! check if variable is dimension 
     276                        ll_dim=.FALSE. 
     277                        DO jj=1,ip_maxdim 
     278                           IF( TRIM(tl_mpp%t_proc(1)%t_dim(jj)%c_name) == & 
     279                           &   TRIM(tl_mpp%t_proc(1)%t_var(jk)%c_name) )THEN 
     280                              ll_dim=.TRUE. 
     281                              CALL logger_trace("MULTI INIT: "//& 
     282                              &  TRIM(tl_mpp%t_proc(1)%t_var(jk)%c_name)//& 
     283                              &  ' is var dimension') 
     284                              EXIT 
     285                           ENDIF 
     286                        ENDDO 
     287                        ! do not use variable dimension 
     288                        IF( ll_dim )THEN 
     289                           tl_var=var_init( & 
     290                           &  TRIM(tl_mpp%t_proc(1)%t_var(jk)%c_name) ) 
     291                           ! delete variable 
     292                           CALL mpp_del_var(tl_mpp,tl_var) 
     293                           ! clean structure 
     294                           CALL var_clean(tl_var) 
     295                        ELSE 
     296                           ! number of variable 
     297                           il_nvar=il_nvar+1 
     298                        ENDIF 
     299 
     300                     ENDDO 
     301 
     302                  ENDIF 
     303 
    153304               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) 
     305 
     306               CALL multi__add_mpp(multi_init, tl_mpp)  
    165307 
    166308               ! 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) 
     309               multi_init%i_nvar=multi_init%i_nvar+il_nvar 
     310 
     311               ! clean 
     312               CALL mpp_clean(tl_mpp) 
    171313 
    172314            ELSE 
    … …  
    182324      ENDDO 
    183325 
    184       ! save result 
    185       multi_init=tl_multi 
    186  
    187326   END FUNCTION multi_init 
    188    ! @endcode 
    189327   !------------------------------------------------------------------- 
    190328   !> @brief This subroutine clean multi file strucutre. 
    191329   ! 
    192330   !> @author J.Paul 
    193    !> - Nov, 2013- Initial Version 
     331   !> @date November, 2013 - Initial Version 
    194332   ! 
    195    !> @param[in] td_multi : multi file structure 
    196    !------------------------------------------------------------------- 
    197    ! @code 
     333   !> @param[in] td_multi  multi file structure 
     334   !------------------------------------------------------------------- 
    198335   SUBROUTINE multi_clean(td_multi) 
    199336      IMPLICIT NONE 
    … …  
    206343 
    207344      ! loop indices 
    208       INTEGER(i4) :: ji 
    209345      !---------------------------------------------------------------- 
    210346 
    211347      CALL logger_info( " CLEAN: reset multi file " ) 
    212348 
    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) 
     349      IF( ASSOCIATED( td_multi%t_mpp ) )THEN 
     350         CALL mpp_clean(td_multi%t_mpp(:)) 
     351         DEALLOCATE(td_multi%t_mpp) 
    218352      ENDIF 
    219353 
    220354      ! replace by empty structure 
    221       td_multi=tl_multi 
     355      td_multi=multi_copy(tl_multi) 
    222356 
    223357   END SUBROUTINE multi_clean 
    224    ! @endcode 
    225358   !------------------------------------------------------------------- 
    226359   !> @brief This subroutine print some information about mpp strucutre. 
    227360   ! 
    228361   !> @author J.Paul 
    229    !> - Nov, 2013- Initial Version 
     362   !> @date November, 2013 - Initial Version 
    230363   ! 
    231    !> @param[in] td_mpp : mpp structure 
    232    !------------------------------------------------------------------- 
    233    ! @code 
     364   !> @param[in] td_multi multi file structure 
     365   !------------------------------------------------------------------- 
    234366   SUBROUTINE multi_print(td_multi) 
    235367      IMPLICIT NONE 
    … …  
    246378 
    247379      ! 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 
     380      IF( td_multi%i_nmpp /= 0 .AND. ASSOCIATED(td_multi%t_mpp) )THEN 
     381         WRITE(*,'(/a,i3)') 'MULTI: total number of mpp: ',& 
     382         &  td_multi%i_nmpp 
    251383         WRITE(*,'(6x,a,i3)') ' total number of variable: ',& 
    252384         &  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),& 
     385         DO ji=1,td_multi%i_nmpp 
     386            WRITE(*,'(3x,3a)') 'MPP FILE ',TRIM(td_multi%t_mpp(ji)%c_name),& 
    255387            & ' 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) 
     388            DO jj=1,td_multi%t_mpp(ji)%t_proc(1)%i_nvar 
     389               IF( ASSOCIATED(td_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN 
     390                  WRITE(*,'(6x,a)') & 
     391                  &  TRIM(td_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 
    259392               ENDIF 
    260393            ENDDO 
    … …  
    263396 
    264397   END SUBROUTINE multi_print 
    265    ! @endcode 
    266398   !------------------------------------------------------------------- 
    267399   !> @brief 
    … …  
    271403   ! 
    272404   !> @author J.Paul 
    273    !> - Nov, 2013- Initial Version 
     405   !> @date November, 2013 - Initial Version 
     406   !> @date October, 2014 
     407   !> - use mpp file structure instead of file 
    274408   ! 
    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 ) 
     409   !> @param[inout] td_multi  multi mpp file strcuture 
     410   !> @param[in]    td_mpp    mpp file strcuture 
     411   !> @return mpp file id in multi mpp file structure 
     412   !------------------------------------------------------------------- 
     413   SUBROUTINE multi__add_mpp( td_multi, td_mpp ) 
    281414      IMPLICIT NONE 
    282415      ! Argument 
    283416      TYPE(TMULTI), INTENT(INOUT) :: td_multi 
    284       TYPE(TFILE) , INTENT(IN)    :: td_file 
    285  
    286       ! function 
    287       INTEGER(i4) :: multi_add_file 
     417      TYPE(TMPP)  , INTENT(IN)    :: td_mpp 
    288418 
    289419      ! local variable 
    290420      INTEGER(i4) :: il_status 
    291       INTEGER(i4) :: il_fileid 
    292       TYPE(TFILE), DIMENSION(:), ALLOCATABLE :: tl_file 
     421      INTEGER(i4) :: il_mppid 
     422       
     423      TYPE(TMPP), DIMENSION(:), ALLOCATABLE :: tl_mpp 
     424 
     425      ! loop indices 
     426      INTEGER(i4) :: ji 
    293427      !---------------------------------------------------------------- 
    294428 
    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)) 
     429      il_mppid=0 
     430      IF( ASSOCIATED(td_multi%t_mpp) )THEN 
     431         il_mppid=mpp_get_index(td_multi%t_mpp(:),TRIM(td_mpp%c_name)) 
    298432      ENDIF 
    299433 
    300       IF( il_fileid /= 0 )THEN 
    301  
    302             multi_add_file=il_fileid 
     434      IF( il_mppid /= 0 )THEN 
     435 
     436            CALL logger_debug( " MULTI ADD FILE: mpp file "//TRIM(td_mpp%c_name)//& 
     437            &               " already in multi mpp file structure") 
     438 
     439            ! add new variable 
     440            DO ji=1,td_mpp%t_proc(1)%i_nvar 
     441               CALL mpp_add_var(td_multi%t_mpp(il_mppid), td_mpp%t_proc(1)%t_var(ji)) 
     442            ENDDO 
    303443 
    304444      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 
     445  
     446         CALL logger_trace("MULTI ADD MPP: add mpp "//& 
     447         &               TRIM(td_mpp%c_name)//" in multi mpp file structure") 
     448 
     449         IF( td_multi%i_nmpp > 0 )THEN 
    310450            !  
    311             ! already other file in multi structure 
    312             ALLOCATE( tl_file(td_multi%i_nfile), stat=il_status ) 
     451            ! already other mpp file in multi file structure 
     452            ALLOCATE( tl_mpp(td_multi%i_nmpp), stat=il_status ) 
    313453            IF(il_status /= 0 )THEN 
    314454 
    315                CALL logger_error( " MULTI ADD FILE: not enough space to put file & 
    316                &               in multi structure") 
     455               CALL logger_error( " MULTI ADD MPP FILE: not enough space to put & 
     456               &               mpp file in multi mpp file structure") 
    317457 
    318458            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) 
     459               ! save temporary multi file structure 
     460               tl_mpp(:)=mpp_copy(td_multi%t_mpp(:)) 
     461 
     462               CALL mpp_clean(td_multi%t_mpp(:)) 
     463               DEALLOCATE( td_multi%t_mpp ) 
     464               ALLOCATE( td_multi%t_mpp(td_multi%i_nmpp+1), stat=il_status) 
    324465               IF(il_status /= 0 )THEN 
    325466 
    326                   CALL logger_error( " MULTI ADD FILE: not enough space to put "//& 
    327                   &  "file in multi structure ") 
     467                  CALL logger_error( " MULTI ADD MPP FILE: not enough space "//& 
     468                  &  "to put mpp file in multi mpp file structure ") 
    328469 
    329470               ENDIF 
    330471 
    331                ! copy file in multi before 
    332                td_multi%t_file(1:td_multi%i_nfile) = tl_file(:) 
    333  
    334                DEALLOCATE(tl_file) 
     472               ! copy mpp file in multi mpp file before 
     473               td_multi%t_mpp(1:td_multi%i_nmpp) = mpp_copy(tl_mpp(:)) 
     474 
     475               ! clean 
     476               CALL mpp_clean(tl_mpp(:)) 
     477               DEALLOCATE(tl_mpp) 
    335478            ENDIF 
    336479 
    337480         ELSE 
    338             ! no processor in mpp structure 
    339             IF( ASSOCIATED(td_multi%t_file) )THEN 
    340                DEALLOCATE(td_multi%t_file) 
     481            ! no file in multi file structure 
     482            IF( ASSOCIATED(td_multi%t_mpp) )THEN 
     483               CALL mpp_clean(td_multi%t_mpp(:)) 
     484               DEALLOCATE(td_multi%t_mpp) 
    341485            ENDIF 
    342             ALLOCATE( td_multi%t_file(td_multi%i_nfile+1), stat=il_status ) 
     486            ALLOCATE( td_multi%t_mpp(td_multi%i_nmpp+1), stat=il_status ) 
    343487            IF(il_status /= 0 )THEN 
    344488 
    345                CALL logger_error( " MULTI ADD FILE: not enough space to put "//& 
    346                &  "file in multi structure " ) 
     489               CALL logger_error( " MULTI ADD MPP FILE: not enough space "//& 
     490               &  "to put mpp file in multi mpp file structure " ) 
    347491 
    348492            ENDIF 
    349493         ENDIF 
    350494 
    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 
     495         ! update number of mpp 
     496         td_multi%i_nmpp=td_multi%i_nmpp+1 
     497 
     498         ! add new mpp 
     499         td_multi%t_mpp(td_multi%i_nmpp)=mpp_copy(td_mpp) 
    357500 
    358501      ENDIF 
    359    END FUNCTION multi_add_file 
    360    !> @endcode 
     502   END SUBROUTINE multi__add_mpp 
    361503END MODULE multi 
    362504 
Note: See TracChangeset for help on using the changeset viewer.