| 1 | program reshape_XIOS_output |
|---|
| 2 | |
|---|
| 3 | !======================================================================= |
|---|
| 4 | ! |
|---|
| 5 | ! Purpose: Read XIOS files, and convert them into the correct GCM grid |
|---|
| 6 | ! XIOS longitudes start at -180 but stop before -180 (not duplicated) |
|---|
| 7 | ! We basically add the last point, and complete the XIOS file. Looped |
|---|
| 8 | ! over the two GCM runs |
|---|
| 9 | ! |
|---|
| 10 | ! Authors: RV & LL |
|---|
| 11 | !======================================================================= |
|---|
| 12 | use netcdf |
|---|
| 13 | implicit none |
|---|
| 14 | integer :: status, ncid, ncid1, ncid2 |
|---|
| 15 | integer :: nDims, nVars, nGlobalAtts, unlimDimID |
|---|
| 16 | integer i,j |
|---|
| 17 | |
|---|
| 18 | integer :: include_parents |
|---|
| 19 | |
|---|
| 20 | integer, dimension(:),allocatable :: dimids |
|---|
| 21 | integer, dimension(:),allocatable :: varids |
|---|
| 22 | |
|---|
| 23 | integer, dimension(:),allocatable :: dimids_2 |
|---|
| 24 | integer, dimension(:),allocatable :: varids_2 |
|---|
| 25 | |
|---|
| 26 | integer, dimension(:),allocatable :: dimid_var |
|---|
| 27 | |
|---|
| 28 | real, dimension(:), allocatable :: tempvalues_1d |
|---|
| 29 | real, dimension(:), allocatable :: values_1d |
|---|
| 30 | |
|---|
| 31 | real, dimension(:,:), allocatable :: tempvalues_2d |
|---|
| 32 | real, dimension(:,:), allocatable :: values_2d |
|---|
| 33 | |
|---|
| 34 | real, dimension(:,:,:), allocatable :: tempvalues_3d |
|---|
| 35 | real, dimension(:,:,:), allocatable :: values_3d |
|---|
| 36 | |
|---|
| 37 | real, dimension(:,:,:,:), allocatable :: tempvalues_4d |
|---|
| 38 | real, dimension(:,:,:,:), allocatable :: values_4d |
|---|
| 39 | |
|---|
| 40 | character*1 str2 |
|---|
| 41 | character*30 :: name_ |
|---|
| 42 | character*30 :: namevar |
|---|
| 43 | integer :: xtype_var |
|---|
| 44 | integer :: len_ |
|---|
| 45 | integer :: len_1,len_2 |
|---|
| 46 | integer :: len_lat, len_lon, len_time, len_soil |
|---|
| 47 | integer :: dimid_lon, dimid_lat, dimid_time, dimid_soil |
|---|
| 48 | integer :: dimid_2 |
|---|
| 49 | integer :: numdims |
|---|
| 50 | integer :: numatts |
|---|
| 51 | integer :: numyear |
|---|
| 52 | |
|---|
| 53 | |
|---|
| 54 | |
|---|
| 55 | |
|---|
| 56 | |
|---|
| 57 | DO numyear=1, 2 |
|---|
| 58 | write(*,*) 'numyear',numyear |
|---|
| 59 | write(str2(1:1),'(i1.1)') numyear |
|---|
| 60 | !nf90_open ! open existing netCDF dataset |
|---|
| 61 | !integer :: ncid, status |
|---|
| 62 | !... |
|---|
| 63 | status = nf90_open(path = "Xdiurnalave"//str2//".nc", mode = nf90_nowrite, ncid = ncid1) |
|---|
| 64 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 65 | |
|---|
| 66 | status = nf90_create(path = "Xdiurnalave"//str2//".nc_new", cmode=or(nf90_noclobber,nf90_64bit_offset), ncid = ncid2) |
|---|
| 67 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 68 | |
|---|
| 69 | status = nf90_inquire(ncid1, ndims, nvars, nglobalatts, unlimdimid) |
|---|
| 70 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 71 | |
|---|
| 72 | allocate(dimids(ndims)) |
|---|
| 73 | allocate(varids(nvars)) |
|---|
| 74 | |
|---|
| 75 | allocate(dimids_2(ndims)) |
|---|
| 76 | allocate(varids_2(nvars)) |
|---|
| 77 | |
|---|
| 78 | status = nf90_inq_dimids(ncid1, ndims, dimids, include_parents) |
|---|
| 79 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 80 | status = nf90_inq_varids(ncid1, nvars, varids) |
|---|
| 81 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 82 | |
|---|
| 83 | do i=1,ndims |
|---|
| 84 | status = nf90_inquire_dimension(ncid1, dimids(i), name_, len_) |
|---|
| 85 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 86 | if(name_.eq."lon") then |
|---|
| 87 | dimid_lon=dimids(i) |
|---|
| 88 | len_lon=len_ |
|---|
| 89 | len_=len_+1 |
|---|
| 90 | elseif(name_.eq."lat") then |
|---|
| 91 | dimid_lat=dimids(i) |
|---|
| 92 | len_lat=len_ |
|---|
| 93 | elseif(name_.eq."time_counter") then |
|---|
| 94 | dimid_time=dimids(i) |
|---|
| 95 | len_time=len_ |
|---|
| 96 | elseif(name_.eq."soil_layers") then |
|---|
| 97 | dimid_soil=dimids(i) |
|---|
| 98 | len_soil=len_ |
|---|
| 99 | endif |
|---|
| 100 | status = nf90_def_dim(ncid2, name_, len_, dimid_2) |
|---|
| 101 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 102 | dimids_2(i)=dimid_2 |
|---|
| 103 | enddo |
|---|
| 104 | |
|---|
| 105 | |
|---|
| 106 | |
|---|
| 107 | allocate(tempvalues_3d(len_lon,len_lat,len_time)) |
|---|
| 108 | allocate(values_3d(len_lon+1,len_lat,len_time)) |
|---|
| 109 | |
|---|
| 110 | allocate(tempvalues_4d(len_lon,len_lat,len_soil,len_time)) |
|---|
| 111 | allocate(values_4d(len_lon+1,len_lat,len_soil,len_time)) |
|---|
| 112 | |
|---|
| 113 | |
|---|
| 114 | do i=1,nvars |
|---|
| 115 | status = nf90_inquire_variable(ncid1, varids(i), name=namevar, xtype=xtype_var, ndims = numdims,natts = numatts) |
|---|
| 116 | print *, "namevar00= ", namevar |
|---|
| 117 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 118 | allocate(dimid_var(numdims)) |
|---|
| 119 | status = nf90_inquire_variable(ncid1, varids(i), name=namevar, xtype=xtype_var, ndims = numdims, dimids=dimid_var, natts = numatts) |
|---|
| 120 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 121 | if(numdims.eq.1) then |
|---|
| 122 | if(namevar.eq."lon") then |
|---|
| 123 | allocate(tempvalues_1d(len_lon)) |
|---|
| 124 | allocate(values_1d(len_lon+1)) |
|---|
| 125 | status = nf90_get_var(ncid1, varids(i), tempvalues_1d) |
|---|
| 126 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 127 | status = nf90_def_var(ncid2, namevar, xtype_var, dimid_var, varids_2(i)) |
|---|
| 128 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 129 | values_1d(1:len_lon)=tempvalues_1d(:) |
|---|
| 130 | values_1d(len_lon+1)=values_1d(1) |
|---|
| 131 | status = nf90_enddef(ncid2) |
|---|
| 132 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 133 | status = nf90_put_var(ncid2, varids_2(i), values_1d) |
|---|
| 134 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 135 | status = nf90_redef(ncid2) |
|---|
| 136 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 137 | deallocate(tempvalues_1d) |
|---|
| 138 | deallocate(values_1d) |
|---|
| 139 | else |
|---|
| 140 | status = nf90_inquire_dimension(ncid1, dimid_var(1), name_, len_) |
|---|
| 141 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 142 | allocate(tempvalues_1d(len_)) |
|---|
| 143 | status = nf90_get_var(ncid1, varids(i), tempvalues_1d) |
|---|
| 144 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 145 | status = nf90_def_var(ncid2, namevar, xtype_var, dimid_var, varids_2(i)) |
|---|
| 146 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 147 | status = nf90_enddef(ncid2) |
|---|
| 148 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 149 | status = nf90_put_var(ncid2, varids_2(i), tempvalues_1d) |
|---|
| 150 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 151 | status = nf90_redef(ncid2) |
|---|
| 152 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 153 | deallocate(tempvalues_1d) |
|---|
| 154 | endif |
|---|
| 155 | elseif(numdims.eq.2) then |
|---|
| 156 | if(namevar.eq."area") then |
|---|
| 157 | allocate(tempvalues_2d(len_lon,len_lat)) |
|---|
| 158 | allocate(values_2d(len_lon+1,len_lat)) |
|---|
| 159 | status = nf90_get_var(ncid1, varids(i), tempvalues_2d) |
|---|
| 160 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 161 | status = nf90_def_var(ncid2, namevar, xtype_var, dimid_var, varids_2(i)) |
|---|
| 162 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 163 | values_2d(1:len_lon,:)=tempvalues_2d(:,:) |
|---|
| 164 | values_2d(len_lon+1,:)=values_2d(1,:) |
|---|
| 165 | status = nf90_enddef(ncid2) |
|---|
| 166 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 167 | status = nf90_put_var(ncid2, varids_2(i), values_2d) |
|---|
| 168 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 169 | status = nf90_redef(ncid2) |
|---|
| 170 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 171 | deallocate(tempvalues_2d) |
|---|
| 172 | deallocate(values_2d) |
|---|
| 173 | else |
|---|
| 174 | status = nf90_inquire_dimension(ncid1, dimid_var(1), name_, len_1) |
|---|
| 175 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 176 | status = nf90_inquire_dimension(ncid1, dimid_var(2), name_, len_2) |
|---|
| 177 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 178 | allocate(tempvalues_2d(len_1,len_2)) |
|---|
| 179 | status = nf90_get_var(ncid1, varids(i), tempvalues_2d) |
|---|
| 180 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 181 | status = nf90_def_var(ncid2, namevar, xtype_var, dimid_var, varids_2(i)) |
|---|
| 182 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 183 | status = nf90_enddef(ncid2) |
|---|
| 184 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 185 | status = nf90_put_var(ncid2, varids_2(i), tempvalues_2d) |
|---|
| 186 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 187 | status = nf90_redef(ncid2) |
|---|
| 188 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 189 | deallocate(tempvalues_2d) |
|---|
| 190 | endif |
|---|
| 191 | elseif(numdims.eq.3) then |
|---|
| 192 | status = nf90_get_var(ncid1, varids(i), tempvalues_3d) |
|---|
| 193 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 194 | status = nf90_def_var(ncid2, namevar, xtype_var, dimid_var, varids_2(i)) |
|---|
| 195 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 196 | values_3d(1:len_lon,:,:)=tempvalues_3d(:,:,:) |
|---|
| 197 | values_3d(len_lon+1,:,:)=values_3d(1,:,:) |
|---|
| 198 | status = nf90_enddef(ncid2) |
|---|
| 199 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 200 | status = nf90_put_var(ncid2, varids_2(i), values_3d) |
|---|
| 201 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 202 | status = nf90_redef(ncid2) |
|---|
| 203 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 204 | elseif(numdims.eq.4) then |
|---|
| 205 | status = nf90_get_var(ncid1, varids(i), tempvalues_4d) |
|---|
| 206 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 207 | status = nf90_def_var(ncid2, namevar, xtype_var, dimid_var, varids_2(i)) |
|---|
| 208 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 209 | status = nf90_enddef(ncid2) |
|---|
| 210 | values_4d(1:len_lon,:,:,:)=tempvalues_4d(:,:,:,:) |
|---|
| 211 | values_4d(len_lon+1,:,:,:)=values_4d(1,:,:,:) |
|---|
| 212 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 213 | status = nf90_put_var(ncid2, varids_2(i), values_4d) |
|---|
| 214 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 215 | status = nf90_redef(ncid2) |
|---|
| 216 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 217 | endif |
|---|
| 218 | |
|---|
| 219 | deallocate(dimid_var) |
|---|
| 220 | enddo |
|---|
| 221 | |
|---|
| 222 | status = nf90_enddef(ncid2) |
|---|
| 223 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 224 | status = nf90_close(ncid1) |
|---|
| 225 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 226 | status = nf90_close(ncid2) |
|---|
| 227 | if(status /= nf90_noerr) call handle_err(status) |
|---|
| 228 | |
|---|
| 229 | |
|---|
| 230 | deallocate(dimids) |
|---|
| 231 | deallocate(varids) |
|---|
| 232 | deallocate(dimids_2) |
|---|
| 233 | deallocate(varids_2) |
|---|
| 234 | deallocate(tempvalues_3d) |
|---|
| 235 | deallocate(values_3d) |
|---|
| 236 | deallocate(tempvalues_4d) |
|---|
| 237 | deallocate(values_4d) |
|---|
| 238 | |
|---|
| 239 | |
|---|
| 240 | |
|---|
| 241 | enddo |
|---|
| 242 | |
|---|
| 243 | end program reshape_XIOS_output |
|---|
| 244 | |
|---|
