forrest@0: program clamp_rewrite forrest@0: forrest@0: ! Program to use CMOR routines to rewrite model results from the simulations forrest@0: ! for the Carbon-Land Model Intercomparison Project (C-LAMP). forrest@0: ! forrest@0: ! Forrest M. Hoffman forrest@0: ! Created: Fri Jun 8 11:50:01 EDT 2007 forrest@0: forrest@0: forrest@0: use cmor_users_functions forrest@0: use netcdf forrest@0: use kind_mod forrest@0: use clm_mod, only: namelen, varnamelen, coord, var_data, & forrest@0: clm_read_coord, clm_copy_grid_data, clm_read_data, clm_convert_data, & forrest@0: clm_free_data forrest@0: implicit none forrest@0: forrest@0: integer, parameter :: maxf = 2500 forrest@0: integer, parameter :: maxv = 200 forrest@0: integer :: i, numf, numv forrest@0: forrest@0: integer, allocatable :: iaxis(:) ! CMOR handle for axes (time, [hour,] [z-level,] latitude, longitude) forrest@0: integer :: ivar ! CMOR handle for variable forrest@0: integer :: ierr ! error flag forrest@0: integer :: axis_num ! axis counter forrest@0: integer :: realization ! model run realization forrest@0: character (len=128) :: input_path ! input path forrest@0: character (len=128) :: fnames(maxf) = '' ! input file names forrest@0: integer :: tshift(maxf) = 0 ! time shift for files forrest@0: character (len=128) :: output_path ! output path forrest@0: character (len=128) :: input_table ! CMOR table path forrest@0: character (len=32) :: vnames(maxv) = '' ! input variable names forrest@0: character (len=256) :: source = '' ! source global attribute forrest@0: character (len=128) :: experiment = '' ! experiment_id global attribute forrest@0: logical :: casa_flux_bug ! scale fluxes due to bug in CASA' forrest@0: forrest@0: real(r4) :: imissing = 1.0e+36 ! missing-data flag on input forrest@0: real(r4) :: omissing = 1.0e+36 ! missing-data flag on output forrest@0: forrest@0: casa_flux_bug = .false. forrest@0: forrest@0: namelist /inparm/ input_table, output_path, experiment, source, & forrest@0: realization, input_path, fnames, tshift, vnames, casa_flux_bug forrest@0: forrest@0: open(10, file='namelist', status='old') forrest@0: ierr = 1 forrest@0: do while(ierr /= 0) forrest@0: read(10, inparm, iostat=ierr) forrest@0: if (ierr < 0) then forrest@0: stop 'End of file on namelist read' forrest@0: end if forrest@0: end do forrest@0: close(10) forrest@0: forrest@0: ! Count number of input data files forrest@0: numf = 0 forrest@0: do i = 1, maxf forrest@0: if (trim(fnames(i)) /= '') numf = numf + 1 forrest@0: end do forrest@0: ! Count number of variables forrest@0: numv = 0 forrest@0: do i = 1, maxv forrest@0: if (trim(vnames(i)) /= '') numv = numv + 1 forrest@0: end do forrest@0: forrest@0: print *, 'Reading input files for coordinates and counts...' forrest@0: call clm_read_coord(numf, input_path, fnames, .true.) forrest@0: forrest@0: do i = 1, numv forrest@0: select case (vnames(i)) forrest@0: ! gca forrest@0: case ('area') forrest@0: call clm_copy_grid_data(vnames(i)) forrest@0: ! lbm forrest@0: case ('landmask') forrest@0: call clm_copy_grid_data(vnames(i)) forrest@0: ! orog forrest@0: case ('topo') forrest@0: call clm_copy_grid_data(vnames(i)) forrest@0: ! sftlf forrest@0: case ('landfrac') forrest@0: call clm_copy_grid_data(vnames(i)) forrest@0: case default forrest@0: print *, 'Reading input files for variable ', vnames(i) forrest@0: call clm_read_data(numf, input_path, fnames, tshift, vnames(i)) forrest@0: forrest@0: !print *,'var_data%varname = ',var_data%varname forrest@0: !print *,'var_data%ndims = ',var_data%ndims forrest@0: !print *,'var_data%time = ',var_data%time forrest@0: !print *,'var_data%long_name = ',trim(var_data%long_name) forrest@0: !print *,'var_data%missing_value = ',var_data%missing_value forrest@0: !print *,'var_data%units = ',trim(var_data%units) forrest@0: end select forrest@0: forrest@0: print *, 'Performing unit conversion on data...' forrest@0: call clm_convert_data(casa_flux_bug) forrest@0: forrest@0: print *, 'Initializing CMOR...' forrest@0: ierr = cmor_setup(inpath='./',netcdf_file_action='preserve', & forrest@0: set_verbosity=2, exit_control=2) forrest@0: forrest@0: print *, 'Identifying output data sets for CMOR...' forrest@0: ierr = cmor_dataset( & forrest@0: outpath = output_path, & forrest@0: experiment_id = experiment, & forrest@0: institution = 'ORNL (Oak Ridge National Laboratory, Oak Ridge, Tennessee, USA)', & forrest@0: source = trim(source), & forrest@0: realization = realization, & forrest@0: calendar = 'noleap', & forrest@0: history = 'Extracted from case '//trim(coord%case_id), & forrest@0: comment = 'Initial dataset: '//trim(coord%inidat)// & forrest@0: '; surface dataset: '//trim(coord%surdat)//'; pft dataset: '//& forrest@0: trim(coord%pftdat)//'; rtm dataset: '//trim(coord%rtmdat), & forrest@0: references = 'http://www.climatemodeling.org/c-lamp', & forrest@0: contact = 'Forrest M. Hoffman ') forrest@0: forrest@0: allocate(iaxis(var_data%ndims), stat=ierr) forrest@0: if (ierr /= 0) then forrest@0: print *, 'Cannot allocate iaxis' forrest@0: stop forrest@0: end if forrest@0: forrest@0: print *, 'Defining coordinates for CMOR output data...' forrest@0: axis_num = 1 forrest@0: forrest@0: iaxis(axis_num) = cmor_axis( & forrest@0: table = input_table, & forrest@0: table_entry = 'longitude', & forrest@0: units = 'degrees_east', & forrest@0: length = coord%xsize, & forrest@0: coord_vals = coord%x) forrest@0: axis_num = axis_num + 1 forrest@0: forrest@0: iaxis(axis_num) = cmor_axis( & forrest@0: table = input_table, & forrest@0: table_entry = 'latitude', & forrest@0: units = 'degrees_north', & forrest@0: length = coord%ysize, & forrest@0: coord_vals = coord%y) forrest@0: axis_num = axis_num + 1 forrest@0: forrest@0: if (var_data%soil_layer_flag) then forrest@0: iaxis(axis_num) = cmor_axis( & forrest@0: table = input_table, & forrest@0: table_entry = 'depth_soil', & forrest@0: units = 'm', & forrest@0: length = coord%zsoi_size, & forrest@0: coord_vals = coord%zsoi) forrest@0: axis_num = axis_num + 1 forrest@0: end if forrest@0: forrest@0: if (var_data%hour_flag) then forrest@0: iaxis(axis_num) = cmor_axis( & forrest@0: table = input_table, & forrest@0: table_entry = 'hour', & forrest@0: units = 'hours', & forrest@0: length = coord%hr_size, & forrest@0: coord_vals = coord%hr) forrest@0: axis_num = axis_num + 1 forrest@0: end if forrest@0: forrest@0: if (var_data%ndims > 2) then forrest@0: iaxis(axis_num) = cmor_axis( & forrest@0: table = input_table, & forrest@0: table_entry = 'time', & forrest@0: units = 'days since 1798-01-01 00:00:00') forrest@0: axis_num = axis_num + 1 forrest@0: end if forrest@0: forrest@0: print *, 'Defining CMOR output data variables...' forrest@0: if (var_data%positive == '') then forrest@0: ivar = cmor_variable( & forrest@0: table = input_table, & forrest@0: table_entry = var_data%out_varname, & forrest@0: original_name = var_data%varname, & forrest@0: units = var_data%units, & forrest@0: missing_value = var_data%missing_value, & forrest@0: axis_ids = iaxis) forrest@0: else forrest@0: ivar = cmor_variable( & forrest@0: table = input_table, & forrest@0: table_entry = var_data%out_varname, & forrest@0: original_name = var_data%varname, & forrest@0: units = var_data%units, & forrest@0: positive = var_data%positive, & forrest@0: missing_value = var_data%missing_value, & forrest@0: axis_ids = iaxis) forrest@0: end if forrest@0: forrest@0: print *, 'Writing CMOR output...' forrest@0: select case (var_data%ndims) forrest@0: case (2) forrest@0: if (var_data%int_type) then forrest@0: ierr = cmor_write( & forrest@0: var_id = ivar, & forrest@0: data = var_data%int2d) forrest@0: else forrest@0: ierr = cmor_write( & forrest@0: var_id = ivar, & forrest@0: data = var_data%var2d) forrest@0: end if forrest@0: case (3) forrest@0: ierr = cmor_write( & forrest@0: var_id = ivar, & forrest@0: data = var_data%var3d, & forrest@0: time_vals = var_data%time, & forrest@0: time_bnds = var_data%time_bounds) forrest@0: case (4) forrest@0: ierr = cmor_write( & forrest@0: var_id = ivar, & forrest@0: data = var_data%var4d, & forrest@0: time_vals = var_data%time, & forrest@0: time_bnds = var_data%time_bounds) forrest@0: case default forrest@0: print *, 'Unable to handle data with ', var_data%ndims, 'dimensions' forrest@0: stop forrest@0: end select forrest@0: forrest@0: print *, 'Closing CMOR file(s)...' forrest@0: ierr = cmor_close() forrest@0: forrest@0: deallocate(iaxis) forrest@0: forrest@0: print *, 'Freeing data...' forrest@0: call clm_free_data() forrest@0: forrest@0: end do ! loop over variables forrest@0: forrest@0: end program clamp_rewrite