! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! + + ! + glimmer_ncparams.f90 - part of the Glimmer-CISM ice model + ! + + ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! ! Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 ! Glimmer-CISM contributors - see AUTHORS file for list of contributors ! ! This file is part of Glimmer-CISM. ! ! Glimmer-CISM is free software: you can redistribute it and/or modify ! it under the terms of the GNU General Public License as published by ! the Free Software Foundation, either version 2 of the License, or (at ! your option) any later version. ! ! Glimmer-CISM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! along with Glimmer-CISM. If not, see . ! ! Glimmer-CISM is hosted on BerliOS.de: ! https://developer.berlios.de/projects/glimmer-cism/ ! ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ #ifdef HAVE_CONFIG_H #include "config.inc" #endif #define NCO outfile%nc #define NCI infile%nc module glimmer_ncparams !*FD read netCDF I/O related configuration files !*FD written by Magnus Hagdorn, May 2004 use glimmer_ncdf, only: glimmer_nc_meta private public :: glimmer_nc_readparams, default_metadata, handle_output, handle_input, configstring type(glimmer_nc_meta),save :: default_metadata character(10000) :: configstring contains subroutine glimmer_nc_readparams(model,config) !*FD read netCDF I/O related configuration file use glide_types use glimmer_config implicit none type(glide_global_type) :: model !*FD model instance type(ConfigSection), pointer :: config !*FD structure holding sections of configuration file ! local variables type(ConfigSection), pointer :: section type(glimmer_nc_output), pointer :: output => null() type(glimmer_nc_input), pointer :: input => null() ! get config string call ConfigAsString(config,configstring) ! get default meta data call GetSection(config,section,'CF default') if (associated(section)) then call handle_metadata(section, default_metadata, .true.) end if ! setup outputs call GetSection(config,section,'CF output') do while(associated(section)) output => handle_output(section,output,model%numerics%tstart,configstring) if (.not.associated(model%funits%out_first)) then model%funits%out_first => output end if call GetSection(section%next,section,'CF output') end do ! setup inputs call GetSection(config,section,'CF input') do while(associated(section)) input => handle_input(section,input) if (.not.associated(model%funits%in_first)) then model%funits%in_first => input end if call GetSection(section%next,section,'CF input') end do output => null() input => null() end subroutine glimmer_nc_readparams !================================================================================== ! private procedures !================================================================================== subroutine handle_metadata(section,metadata, default) use glimmer_ncdf use glimmer_config implicit none type(ConfigSection), pointer :: section type(glimmer_nc_meta) ::metadata logical :: default character(len=100), external :: glimmer_version_char ! local variables character(len=8) :: date character(len=10) :: time if (.not.default) then metadata%title = trim(default_metadata%title) metadata%institution = trim(default_metadata%institution) metadata%references = trim(default_metadata%references) metadata%comment = trim(default_metadata%comment) end if call GetValue(section,'title',metadata%title) call GetValue(section,'institution',metadata%institution) call GetValue(section,'references',metadata%references) call GetValue(section,'comment',metadata%comment) if (default) then call date_and_time(date,time) metadata%source = 'Generated by '//trim(glimmer_version_char()) write(metadata%history,fmt="(a4,'-',a2,'-',a2,' ',a2,':',a2,':',a6,' : ',a)") date(1:4),date(5:6),date(7:8),& time(1:2),time(3:4),time(5:10),trim(glimmer_version_char()) else metadata%source = trim(default_metadata%source) metadata%history = trim(default_metadata%history) end if end subroutine handle_metadata function handle_output(section, output, start_yr, configstring) use glimmer_ncdf use glimmer_config use glimmer_log use glimmer_global, only: dp implicit none type(ConfigSection), pointer :: section type(glimmer_nc_output), pointer :: output type(glimmer_nc_output), pointer :: handle_output real(dp), intent(in) :: start_yr character(*),intent(in) :: configstring character(10) :: mode_str,xtype_str handle_output=>add(output) handle_output%next_write = start_yr mode_str='' xtype_str = 'real' ! get filename call GetValue(section,'name',handle_output%nc%filename) call GetValue(section,'start',handle_output%next_write) call GetValue(section,'stop',handle_output%end_write) call GetValue(section,'frequency',handle_output%freq) call GetValue(section,'variables',handle_output%nc%vars) call GetValue(section,'mode',mode_str) call GetValue(section,'xtype',xtype_str) ! handle mode field if (trim(mode_str)=='append'.or.trim(mode_str)=='APPEND') then handle_output%append = .true. else handle_output%append = .false. end if ! handle xtype field if (trim(xtype_str)=='real'.or.trim(xtype_str)=='REAL') then handle_output%default_xtype = NF90_REAL else if (trim(xtype_str)=='double'.or.trim(xtype_str)=='DOUBLE') then handle_output%default_xtype = NF90_DOUBLE else call write_log('Error, unknown xtype, must be real or double [netCDF output]',GM_FATAL) end if ! add config data handle_output%metadata%config=trim(configstring) ! Make copy of variables for future reference handle_output%nc%vars_copy=handle_output%nc%vars ! get metadata call handle_metadata(section, handle_output%metadata,.false.) if (handle_output%nc%filename(1:1).eq.' ') then call write_log('Error, no file name specified [netCDF output]',GM_FATAL) end if end function handle_output function handle_input(section, input) use glimmer_ncdf use glimmer_config use glimmer_log use glimmer_filenames, only : filenames_inputname implicit none type(ConfigSection), pointer :: section type(glimmer_nc_input), pointer :: input type(glimmer_nc_input), pointer :: handle_input handle_input=>add(input) ! get filename call GetValue(section,'name',handle_input%nc%filename) call GetValue(section,'time',handle_input%get_time_slice) handle_input%current_time = handle_input%get_time_slice if (handle_input%nc%filename(1:1).eq.' ') then call write_log('Error, no file name specified [netCDF input]',GM_FATAL) end if handle_input%nc%filename = trim(filenames_inputname(handle_input%nc%filename)) end function handle_input end module glimmer_ncparams