historyautoallvarfix.f90

Go to the documentation of this file.

 
 
  subroutine historyautoallvarfix
    use gtool_historyauto_internal, only: initialized, numvars, &
      & flag_allvarfixed, gthst_vars, gthstnml, save_mpi_gather, sub_sname
    use gtool_history_nmlinfo_generic, only: hstnmlinfoallnamevalid
    use gtool_history, only: historyvarinfoinquire
    use dc_trace, only: beginsub, endsub
    use dc_error, only: storeerror, dc_noerr, hst_ebadvarname, dc_enotinit
    use dc_message, only: messagenotify
    use dc_date, only: operator(*), operator(+)
    use dc_string, only: joinchar
    use dc_types, only: string, token
 
    implicit none
    logical:: allvar_invalid
                              ! 無効な変数名のチェックフラグ. 
                              ! Check flag of invalid variable names. 
 
    integer, parameter:: names_limit = 100
    character(names_limit):: names_invalid
                              ! 無効な変数名. 
                              ! Invalid variable names. 
 
    character(STRING):: name, units, longname, var_info_str
    character(TOKEN), pointer:: dims(:) =>null()
    integer:: msnot_rank
    integer:: stat, i
    character(STRING):: cause_c
    character(*), parameter:: subname = "HistoryAutoAllVarFix"
  continue
    call beginsub(subname)
    stat = dc_noerr
    cause_c = ""
 
    ! 初期設定チェック
    ! Check initialization
    !
    if ( .not. initialized ) then
      stat = dc_enotinit
      cause_c = 'gtool_historyauto'
      goto 999
    end if
 
    ! 既に確定後であれば何もせずに終了. 
    ! Nothing is done after fixed
    !
    if ( flag_allvarfixed ) goto 999
 
 
    ! 無効な変数名のチェック (初回のみ)
    ! Check invalid variable names (at only first time)
    !
    call hstnmlinfoallnamevalid( &
      & gthstnml = gthstnml, &               ! (inout)
      & invalid = allvar_invalid, names = names_invalid ) ! (out)
 
    if ( len_trim(names_invalid) > (names_limit - 5)  ) then
      names_invalid = names_invalid(1:names_limit - 5) // ' ....'
    end if
 
    if ( allvar_invalid ) then
      stat = hst_ebadvarname
      cause_c = names_invalid
      call messagenotify( 'W', subname, &
        & 'names "%c" from NAMELIST "gtool_historyauto_nml" are invalid.', &
        & c1 = trim(names_invalid) )
      goto 999
    end if
 
    ! 登録された変数の印字 (初回のみ)
    ! Print registered variables (at only first time)
    !
    msnot_rank = -1
    if ( save_mpi_gather ) msnot_rank = 0
    call messagenotify( 'M', sub_sname, '-------------------------------------------', rank_mpi = msnot_rank )
    call messagenotify( 'M', sub_sname, '----- Registered variables for output -----', rank_mpi = msnot_rank )
    call messagenotify( 'M', sub_sname, '-------------------------------------------', rank_mpi = msnot_rank )
 
    do i = 1, numvars
      call historyvarinfoinquire( &
        & varinfo = gthst_vars(i), &    ! (in)
        & name = name, &                ! (out) optional
        & dims = dims, &                ! (out) optional
        & longname = longname, &        ! (out) optional
        & units = units )               ! (out) optional
 
      var_info_str = trim( longname ) // ' [' // &
        &            trim( units ) // '] {' // &
        &            trim( joinchar( dims, ',' ) ) // '}'
      deallocate( dims )
 
      call messagenotify( 'M', sub_sname, '  %c  (%c)', &
        & c1 = trim(name), c2 = trim(var_info_str), rank_mpi = msnot_rank )
 
    end do
    call messagenotify( 'M', sub_sname, '-----', rank_mpi = msnot_rank )
 
    ! フラグの設定
    ! Set a flag
    !
    if ( .not. flag_allvarfixed ) flag_allvarfixed = .true.
 
999 continue
    call storeerror(stat, subname, cause_c = cause_c)
    call endsub(subname, 'stat=%d', i = (/stat/) )
  end subroutine historyautoallvarfix