!---------------------------------------------------------------------- ! NEMO system team, System and Interface for oceanic RElocable Nesting !---------------------------------------------------------------------- ! ! MODULE: multi ! ! DESCRIPTION: !> This module manage multi file structure. ! !> @details !> define type TMULTI:
!> @code !> TYPE(TMULTI) :: tl_multi !> @endcode !> !> to initialize a multi-file structure:
!> @code !> tl_multi=multi_init(cd_varfile(:)) !> @endcode !> - cd_varfile : array of variable with file path !> ('var1:file1','var2:file2')
!> file path could be replaced by a matrix of value.
!> separators used to defined matrix are: !> - ',' for line !> - '/' for row !> - '\' for level
!> Example:
!> - 'var1:3,2,3/1,4,5' !> - 3,2,3/1,4,5 => !> @f$ \left( \begin{array}{ccc} !> 3 & 2 & 3 \\ !> 1 & 4 & 5 \end{array} \right) @f$
!> !> to get the number of mpp file in mutli file structure:
!> - tl_multi\%i_nmpp !> !> to get the total number of variable in mutli file structure:
!> - tl_multi\%i_nvar !> !> @note number of variable and number of file could differ cause several variable !> could be in the same file. !> !> to get array of mpp structure in mutli file structure:
!> - tl_multi\%t_mpp(:) !> !> to print information about multi structure:
!> @code !> CALL multi_print(td_multi) !> @endcode !> !> to clean multi file strucutre:
!> @code !> CALL multi_clean(td_multi) !> @endcode !> - td_multi is multi file structure !> !> @author !> J.Paul ! REVISION HISTORY: !> @date November, 2013 - Initial Version !> @date October, 2014 !> - use mpp file structure instead of file !> @date November, 2014 - Fix memory leaks bug ! !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) !---------------------------------------------------------------------- MODULE multi USE kind ! F90 kind parameter USE logger ! log file manager USE fct ! basic useful function USE dim ! dimension manager USE var ! variable manager USE file ! file manager USE iom ! I/O manager USE mpp ! MPP manager USE iom_mpp ! MPP I/O manager IMPLICIT NONE ! NOTE_avoid_public_variables_if_possible ! type and variable PUBLIC :: TMULTI !< multi file structure ! function and subroutine PUBLIC :: multi_copy !< copy multi structure PUBLIC :: multi_init !< initialise multi structure PUBLIC :: multi_clean !< clean multi strcuture PUBLIC :: multi_print !< print information about milti structure PUBLIC :: multi__add_mpp !< add file strucutre to multi file structure PRIVATE :: multi__copy_unit !< copy multi file structure TYPE TMULTI !< multi file structure ! general INTEGER(i4) :: i_nmpp = 0 !< number of mpp files INTEGER(i4) :: i_nvar = 0 !< total number of variables TYPE(TMPP) , DIMENSION(:), POINTER :: t_mpp => NULL() !< mpp files composing multi END TYPE INTERFACE multi_copy MODULE PROCEDURE multi__copy_unit ! copy multi file structure END INTERFACE CONTAINS !------------------------------------------------------------------- !> @brief !> This function copy multi mpp structure in another one !> @details !> file variable value are copied in a temporary array, !> so input and output file structure value do not point on the same !> "memory cell", and so on are independant. !> !> @warning do not use on the output of a function who create or read an !> attribute (ex: tl_att=att_copy(att_init()) is forbidden). !> This will create memory leaks. !> @warning to avoid infinite loop, do not use any function inside !> this subroutine !> !> @author J.Paul !> - November, 2013- Initial Version !> @date November, 2014 !> - use function instead of overload assignment operator (to avoid memory leak) !> !> @param[in] td_multi mpp structure !> @return copy of input multi structure !------------------------------------------------------------------- FUNCTION multi__copy_unit( td_multi ) IMPLICIT NONE ! Argument TYPE(TMULTI), INTENT(IN) :: td_multi ! function TYPE(TMULTI) :: multi__copy_unit ! local variable TYPE(TMPP) :: tl_mpp ! loop indices INTEGER(i4) :: ji !---------------------------------------------------------------- multi__copy_unit%i_nmpp = td_multi%i_nmpp multi__copy_unit%i_nvar = td_multi%i_nvar ! copy variable structure IF( ASSOCIATED(multi__copy_unit%t_mpp) )THEN CALL mpp_clean(multi__copy_unit%t_mpp(:)) DEALLOCATE(multi__copy_unit%t_mpp) ENDIF IF( ASSOCIATED(td_multi%t_mpp) .AND. multi__copy_unit%i_nmpp > 0 )THEN ALLOCATE( multi__copy_unit%t_mpp(multi__copy_unit%i_nmpp) ) DO ji=1,multi__copy_unit%i_nmpp tl_mpp = mpp_copy(td_multi%t_mpp(ji)) multi__copy_unit%t_mpp(ji) = mpp_copy(tl_mpp) ENDDO ! clean CALL mpp_clean(tl_mpp) ENDIF END FUNCTION multi__copy_unit !------------------------------------------------------------------- !> @brief This subroutine initialize multi file structure. !> !> @details !> if variable name is 'all', add all the variable of the file in mutli file !> structure. !> @note if first character of filename is numeric, assume matrix is given as !> input.
!> create pseudo file named 'data-*', with matrix read as variable value. !> !> @author J.Paul !> - November, 2013- Initial Version !> !> @param[in] cd_varfile variable location information (from namelist) !> @return multi file structure !------------------------------------------------------------------- FUNCTION multi_init(cd_varfile) IMPLICIT NONE ! Argument CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_varfile ! function TYPE(TMULTI) :: multi_init ! local variable CHARACTER(LEN=lc) :: cl_name CHARACTER(LEN=lc) :: cl_lower CHARACTER(LEN=lc) :: cl_file CHARACTER(LEN=lc) :: cl_matrix INTEGER(i4) :: il_nvar LOGICAL :: ll_dim TYPE(TVAR) :: tl_var TYPE(TMPP) :: tl_mpp ! loop indices INTEGER(i4) :: ji INTEGER(i4) :: jj INTEGER(i4) :: jk !---------------------------------------------------------------- ji=1 DO WHILE( TRIM(cd_varfile(ji)) /= '' ) il_nvar=0 cl_name=fct_split(cd_varfile(ji),1,':') cl_lower=fct_lower(cl_name) cl_file=fct_split(cd_varfile(ji),2,':') IF( LEN(TRIM(cl_file)) == lc )THEN CALL logger_fatal("MULTI INIT: file name too long (==256)."//& & " check namelist.") ENDIF IF( TRIM(cl_lower) /= '' )THEN IF( TRIM(cl_file) /= '' )THEN cl_matrix='' IF( fct_is_num(cl_file(1:1)) )THEN cl_matrix=TRIM(cl_file) WRITE(cl_file,'(a,i2.2)')'data-',ji tl_var=var_init(TRIM(cl_name)) CALL var_read_matrix(tl_var, cl_matrix) ! create mpp structure tl_mpp=mpp_init(TRIM(cl_file), tl_var) ! add variable CALL mpp_add_var(tl_mpp,tl_var) ! number of variable il_nvar=il_nvar+1 ELSE ! tl_mpp=mpp_init( file_init(TRIM(cl_file)) ) ! define variable IF( TRIM(fct_lower(cl_lower)) /= 'all' )THEN ! clean var CALL mpp_del_var(tl_mpp) tl_var=var_init(TRIM(cl_lower)) ! add variable CALL mpp_add_var(tl_mpp,tl_var) ! number of variable il_nvar=il_nvar+1 ! clean structure CALL var_clean(tl_var) ELSE ! cl_lower == 'all' DO jk=tl_mpp%t_proc(1)%i_nvar,1,-1 ! check if variable is dimension ll_dim=.FALSE. DO jj=1,ip_maxdim IF( TRIM(tl_mpp%t_proc(1)%t_dim(jj)%c_name) == & & TRIM(tl_mpp%t_proc(1)%t_var(jk)%c_name) )THEN ll_dim=.TRUE. CALL logger_trace("MULTI INIT: "//& & TRIM(tl_mpp%t_proc(1)%t_var(jk)%c_name)//& & ' is var dimension') EXIT ENDIF ENDDO ! do not use variable dimension IF( ll_dim )THEN tl_var=var_init( & & TRIM(tl_mpp%t_proc(1)%t_var(jk)%c_name) ) ! delete variable CALL mpp_del_var(tl_mpp,tl_var) ! clean structure CALL var_clean(tl_var) ELSE ! number of variable il_nvar=il_nvar+1 ENDIF ENDDO ENDIF ENDIF CALL multi__add_mpp(multi_init, tl_mpp) ! update total number of variable multi_init%i_nvar=multi_init%i_nvar+il_nvar ! clean CALL mpp_clean(tl_mpp) ELSE CALL logger_error("MULTI INIT: file name matching variable "//& & TRIM(cl_name)//" is empty. check namelist.") ENDIF ELSE CALL logger_error("MULTI INIT: variable name "//& & "is empty. check namelist.") ENDIF ji=ji+1 ENDDO END FUNCTION multi_init !------------------------------------------------------------------- !> @brief This subroutine clean multi file strucutre. ! !> @author J.Paul !> - November, 2013- Initial Version ! !> @param[in] td_multi multi file structure !------------------------------------------------------------------- SUBROUTINE multi_clean(td_multi) IMPLICIT NONE ! Argument TYPE(TMULTI), INTENT(INOUT) :: td_multi ! local variable TYPE(TMULTI) :: tl_multi ! empty multi file structure ! loop indices !---------------------------------------------------------------- CALL logger_info( " CLEAN: reset multi file " ) IF( ASSOCIATED( td_multi%t_mpp ) )THEN CALL mpp_clean(td_multi%t_mpp(:)) DEALLOCATE(td_multi%t_mpp) ENDIF ! replace by empty structure td_multi=multi_copy(tl_multi) END SUBROUTINE multi_clean !------------------------------------------------------------------- !> @brief This subroutine print some information about mpp strucutre. ! !> @author J.Paul !> - November, 2013- Initial Version ! !> @param[in] td_multi multi file structure !------------------------------------------------------------------- SUBROUTINE multi_print(td_multi) IMPLICIT NONE ! Argument TYPE(TMULTI), INTENT(IN) :: td_multi ! local variable ! loop indices INTEGER(i4) :: ji INTEGER(i4) :: jj !---------------------------------------------------------------- ! print file IF( td_multi%i_nmpp /= 0 .AND. ASSOCIATED(td_multi%t_mpp) )THEN WRITE(*,'(/a,i3)') 'MULTI: total number of mpp: ',& & td_multi%i_nmpp WRITE(*,'(6x,a,i3)') ' total number of variable: ',& & td_multi%i_nvar DO ji=1,td_multi%i_nmpp WRITE(*,'(3x,3a)') 'MPP FILE ',TRIM(td_multi%t_mpp(ji)%c_name),& & ' CONTAINS' DO jj=1,td_multi%t_mpp(ji)%t_proc(1)%i_nvar IF( ASSOCIATED(td_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN WRITE(*,'(6x,a)') & & TRIM(td_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) ENDIF ENDDO ENDDO ENDIF END SUBROUTINE multi_print !------------------------------------------------------------------- !> @brief !> This subroutine add file to multi file structure. !> !> @detail ! !> @author J.Paul !> - November, 2013- Initial Version !> @date October, 2014 !> - use mpp file structure instead of file ! !> @param[inout] td_multi multi mpp file strcuture !> @param[in] td_mpp mpp file strcuture !> @return mpp file id in multi mpp file structure !------------------------------------------------------------------- SUBROUTINE multi__add_mpp( td_multi, td_mpp ) IMPLICIT NONE ! Argument TYPE(TMULTI), INTENT(INOUT) :: td_multi TYPE(TMPP) , INTENT(IN) :: td_mpp ! local variable INTEGER(i4) :: il_status INTEGER(i4) :: il_mppid TYPE(TMPP), DIMENSION(:), ALLOCATABLE :: tl_mpp ! loop indices INTEGER(i4) :: ji !---------------------------------------------------------------- il_mppid=0 IF( ASSOCIATED(td_multi%t_mpp) )THEN il_mppid=mpp_get_index(td_multi%t_mpp(:),TRIM(td_mpp%c_name)) ENDIF IF( il_mppid /= 0 )THEN CALL logger_debug( " MULTI ADD FILE: mpp file "//TRIM(td_mpp%c_name)//& & " already in multi mpp file structure") ! add new variable DO ji=1,td_mpp%t_proc(1)%i_nvar CALL mpp_add_var(td_multi%t_mpp(il_mppid), td_mpp%t_proc(1)%t_var(ji)) ENDDO ELSE CALL logger_trace("MULTI ADD MPP: add mpp "//& & TRIM(td_mpp%c_name)//" in multi mpp file structure") IF( td_multi%i_nmpp > 0 )THEN ! ! already other mpp file in multi file structure ALLOCATE( tl_mpp(td_multi%i_nmpp), stat=il_status ) IF(il_status /= 0 )THEN CALL logger_error( " MULTI ADD MPP FILE: not enough space to put & & mpp file in multi mpp file structure") ELSE ! save temporary multi file structure tl_mpp(:)=mpp_copy(td_multi%t_mpp(:)) CALL mpp_clean(td_multi%t_mpp(:)) DEALLOCATE( td_multi%t_mpp ) ALLOCATE( td_multi%t_mpp(td_multi%i_nmpp+1), stat=il_status) IF(il_status /= 0 )THEN CALL logger_error( " MULTI ADD MPP FILE: not enough space "//& & "to put mpp file in multi mpp file structure ") ENDIF ! copy mpp file in multi mpp file before td_multi%t_mpp(1:td_multi%i_nmpp) = mpp_copy(tl_mpp(:)) ! clean CALL mpp_clean(tl_mpp(:)) DEALLOCATE(tl_mpp) ENDIF ELSE ! no file in multi file structure IF( ASSOCIATED(td_multi%t_mpp) )THEN CALL mpp_clean(td_multi%t_mpp(:)) DEALLOCATE(td_multi%t_mpp) ENDIF ALLOCATE( td_multi%t_mpp(td_multi%i_nmpp+1), stat=il_status ) IF(il_status /= 0 )THEN CALL logger_error( " MULTI ADD MPP FILE: not enough space "//& & "to put mpp file in multi mpp file structure " ) ENDIF ENDIF ! update number of mpp td_multi%i_nmpp=td_multi%i_nmpp+1 ! add new mpp td_multi%t_mpp(td_multi%i_nmpp)=mpp_copy(td_mpp) ENDIF END SUBROUTINE multi__add_mpp END MODULE multi