Changeset 3786 for trunk/LMDZ.COMMON
- Timestamp:
- Jun 2, 2025, 5:17:38 PM (3 weeks ago)
- Location:
- trunk/LMDZ.COMMON/libf/evolution
- Files:
-
- 3 edited
-
changelog.txt (modified) (1 diff)
-
pem.F90 (modified) (2 diffs)
-
reshape_XIOS_output.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
TabularUnified trunk/LMDZ.COMMON/libf/evolution/changelog.txt ¶
r3785 r3786 689 689 - Consideration of a threshold under which H2O ice lag layer is considered patchy 690 690 - Deletion of unused function 'thickness_toplag' 691 692 == 02/06/2025 == JBC 693 Optimization (computing time is devided by 2.2) of the program "reshape_XIOS_output" to convert XIOS output onto the PCM grid. -
TabularUnified trunk/LMDZ.COMMON/libf/evolution/pem.F90 ¶
r3785 r3786 300 300 logical :: num_str 301 301 302 ! CODE 302 303 write(*,*) ' * . . + . * . + . . . ' 303 304 write(*,*) ' + _______ ________ ____ ____ * + ' … … 358 359 else ! Arg is not a numeric string 359 360 select case (trim(adjustl(arg))) 360 case('version') 361 case('version') ! Handle command‐line argument "version" 361 362 call print_version_info() 362 363 stop -
TabularUnified trunk/LMDZ.COMMON/libf/evolution/reshape_XIOS_output.F90 ¶
r3649 r3786 2 2 3 3 !======================================================================= 4 ! Purpose: Read XIOS NetCDF files and convert them onto the PCM grid. 5 ! XIOS longitudes run from -180 to +180 (exclusive). So we append 6 ! the first longitude value again at the end in the output to 7 ! complete the grid. Done for the two PCM years. 4 8 ! 5 ! Purpose: Read XIOS files, and convert them into the correct PCM 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 PCM runs 9 ! 10 ! Authors: RV & LL 9 ! Authors: RV & LL (original), JBC (optimized) 11 10 !======================================================================= 11 12 12 use netcdf 13 13 use version_info_mod, only: print_version_info … … 15 15 implicit none 16 16 17 integer :: state, ncid1, ncid2, nDims, nVars, nGlobalAtts, unlimDimID 18 integer :: i, include_parents, cstat 19 integer, dimension(:), allocatable :: dimids, varids, dimids_2, varids_2, dimid_var 20 real, dimension(:), allocatable :: tempvalues_1d, values_1d 21 real, dimension(:,:), allocatable :: tempvalues_2d, values_2d 22 real, dimension(:,:,:), allocatable :: tempvalues_3d, values_3d 23 real, dimension(:,:,:,:), allocatable :: tempvalues_4d, values_4d 24 character(1) :: str 25 character(30) :: name_, namevar 26 character(100) :: arg ! To read command-line arguments 27 integer :: xtype_var, len_, len_1, len_2, len_lat, len_lon, len_time, len_soil 28 integer :: dimid_lon, dimid_lat, dimid_time, dimid_soil, dimid_2, numdims, numatts, numyear 29 logical :: yes 30 31 17 ! Variables for NetCDF I/O and bookkeeping 18 integer :: state 19 integer :: ncid_in, ncid_out 20 integer :: ndims, nvars, nGlobalAtts, unlimDimID 21 integer, allocatable, dimension(:) :: dimids_in, varids_in 22 integer, allocatable, dimension(:) :: dimids_out, varids_out 23 24 ! Store each input dimension name and length 25 character(30), allocatable, dimension(:) :: dimNames 26 integer, allocatable, dimension(:) :: dimLens 27 28 ! Which input‐index corresponds to lon/lat/time/soil (–1 if not present) 29 integer :: idx_lon_in = -1 30 integer :: idx_lat_in = -1 31 integer :: idx_time_in = -1 32 integer :: idx_soil_in = -1 33 34 ! Lengths of key dims (input), plus output lon length 35 integer :: len_lon_in, len_lat_in, len_time_in, len_soil_in 36 integer :: len_lon_out 37 38 ! Loop and variable bookkeeping 39 integer :: i, j, k 40 integer :: numDimsVar, numAttsVar 41 character(100) :: varName, arg 42 integer :: xtypeVar 43 integer, allocatable, dimension(:) :: dimids_var_in 44 45 ! Buffers for reading/writing when first‐dim = lon (max‐sized) 46 real, allocatable, dimension(:) :: buf1D_in, buf1D_out 47 real, allocatable, dimension(:,:) :: buf2D_in, buf2D_out 48 real, allocatable, dimension(:,:,:) :: buf3D_in, buf3D_out 49 real, allocatable, dimension(:,:,:,:) :: buf4D_in, buf4D_out 50 51 ! Temporaries for "non‐lon‐first" variables 52 real, allocatable, dimension(:) :: tmp1D 53 real, allocatable, dimension(:,:) :: tmp2D 54 real, allocatable, dimension(:,:,:) :: tmp3D 55 real, allocatable, dimension(:,:,:,:) :: tmp4D 56 57 ! Temporaries for dimension inquiries 58 integer :: thisLen 59 integer :: len1, len2, len3, len4 60 integer :: lenDim2, lenDim3, lenDim4 61 character(30) :: tmpDimName 62 63 logical :: uses_lon_first 64 65 ! For looping over two "years" 66 integer :: numyear 67 character(4) :: str 68 69 ! For deleting existing output 70 integer :: cstat 71 logical :: exists 72 73 ! CODE 74 ! Handle command‐line argument "version" 32 75 if (command_argument_count() > 0) then ! Get the number of command-line arguments 33 76 call get_command_argument(1,arg) ! Read the argument given to the program … … 41 84 endif 42 85 86 ! Main loop: two PCM years 43 87 do numyear = 1,2 44 write(str,'(i1.1)') numyear 45 write(*,*) '> Reshaping of variables from "data2reshape_Y'//str//'.nc"...' 46 47 state = nf90_open(path = "data2reshape_Y"//str//".nc",mode = nf90_nowrite,ncid = ncid1) 48 if (state /= nf90_noerr) call handle_err(state) 49 50 inquire(file = 'data_PCM_Y'//str//'.nc', exist = yes) 51 if (yes) then 52 call execute_command_line('rm data_PCM_Y'//str//'.nc',cmdstat = cstat) 88 write(str,'(I1.1)') numyear 89 write(*,*) "> Reshaping variables from ""data2reshape_Y"//trim(str)//".nc""..." 90 91 ! Open input file (read‐only) 92 state = nf90_open("data2reshape_Y"//trim(str)//".nc",mode = nf90_nowrite,ncid = ncid_in) 93 if (state /= nf90_noerr) call handle_err(state) 94 95 ! If output exists, delete it 96 inquire(file = "data_PCM_Y"//trim(str)//".nc",exist = exists) 97 if (exists) then 98 call execute_command_line("rm data_PCM_Y"//trim(str)//".nc",cmdstat = cstat) 53 99 if (cstat > 0) then 54 100 error stop 'Command exection failed!' … … 57 103 endif 58 104 endif 59 state = nf90_create(path = "data_PCM_Y"//str//".nc",cmode = or(nf90_noclobber,nf90_64bit_offset),ncid = ncid2) 60 if (state /= nf90_noerr) call handle_err(state) 61 62 state = nf90_inquire(ncid1, ndims, nvars, nglobalatts, unlimdimid) 63 if (state /= nf90_noerr) call handle_err(state) 64 65 allocate(dimids(ndims)) 66 allocate(varids(nvars)) 67 68 allocate(dimids_2(ndims)) 69 allocate(varids_2(nvars)) 70 71 state = nf90_inq_dimids(ncid1,ndims,dimids,include_parents) 72 if (state /= nf90_noerr) call handle_err(state) 73 state = nf90_inq_varids(ncid1,nvars,varids) 105 106 ! Create output file in define mode 107 state = nf90_create("data_PCM_Y"//trim(str)//".nc",cmode = or(nf90_noclobber,nf90_64bit_offset),ncid = ncid_out) 108 if (state /= nf90_noerr) call handle_err(state) 109 110 ! Inquire input for dims, vars, global atts, unlimited dim ID 111 state = nf90_inquire(ncid_in,ndims,nvars,nGlobalAtts,unlimDimID) 112 if (state /= nf90_noerr) call handle_err(state) 113 114 ! Allocate arrays for dim IDs, var IDs, names, lengths 115 allocate(dimids_in(ndims),varids_in(nvars),dimids_out(ndims),varids_out(nvars),dimNames(ndims),dimLens(ndims)) 116 117 ! Get the dimension IDs and then query each for its name and length 118 state = nf90_inq_dimids(ncid_in,ndims,dimids_in,unlimDimID) 74 119 if (state /= nf90_noerr) call handle_err(state) 75 120 76 121 do i = 1,ndims 77 state = nf90_inquire_dimension(ncid1,dimids(i),name_,len_) 78 if (state /= nf90_noerr) call handle_err(state) 79 if (name_ == "lon" .or. name_ == "longitude") then 80 dimid_lon = dimids(i) 81 len_lon = len_ 82 len_ = len_ + 1 83 else if (name_ == "lat".or. name_ == "latitude") then 84 dimid_lat = dimids(i) 85 len_lat = len_ 86 else if (name_ == "time_counter".or. name_ == "Time") then 87 dimid_time = dimids(i) 88 len_time = len_ 89 else if (name_ == "soil_layers".or. name_ == "subsurface_layers") then 90 dimid_soil = dimids(i) 91 len_soil = len_ 122 state = nf90_inquire_dimension(ncid_in,dimids_in(i),dimNames(i),dimLens(i)) 123 if (state /= nf90_noerr) call handle_err(state) 124 125 select case (trim(dimNames(i))) 126 case ("lon","longitude") 127 idx_lon_in = i 128 len_lon_in = dimLens(i) 129 case ("lat","latitude") 130 idx_lat_in = i 131 len_lat_in = dimLens(i) 132 case ("time_counter","Time") 133 idx_time_in = i 134 len_time_in = dimLens(i) 135 case ("soil_layers","subsurface_layers") 136 idx_soil_in = i 137 len_soil_in = dimLens(i) 138 case default 139 ! nothing special 140 end select 141 142 ! Define the same dimension in the output, except lon becoming (len_lon_in + 1) 143 if (i == idx_lon_in) then 144 len_lon_out = len_lon_in + 1 145 state = nf90_def_dim(ncid_out,trim(dimNames(i)),len_lon_out,dimids_out(i)) 146 else 147 state = nf90_def_dim(ncid_out,trim(dimNames(i)),dimLens(i),dimids_out(i)) 92 148 endif 93 state = nf90_def_dim(ncid2,name_,len_,dimid_2) 94 if (state /= nf90_noerr) call handle_err(state) 95 dimids_2(i) = dimid_2 149 if (state /= nf90_noerr) call handle_err(state) 96 150 enddo 97 151 152 ! Ensure mandatory dims exist 153 if (idx_lon_in < 0 .or. idx_lat_in < 0) error stop "Input is missing mandatory 'lon' or 'lat' dimension." 154 if (idx_time_in < 0) len_time_in = 1 155 if (idx_soil_in < 0) len_soil_in = 1 156 157 ! Allocate only the "lon‐first" buffers (max‐sized) once 158 allocate(buf1D_in(len_lon_in),buf1D_out(len_lon_out)) 159 allocate(buf2D_in(len_lon_in,len_lat_in),buf2D_out(len_lon_out, len_lat_in)) 160 allocate(buf3D_in(len_lon_in,len_lat_in,len_time_in),buf3D_out(len_lon_out,len_lat_in,len_time_in)) 161 allocate(buf4D_in(len_lon_in,len_lat_in,len_soil_in,len_time_in),buf4D_out(len_lon_out,len_lat_in,len_soil_in,len_time_in)) 162 163 ! Get all variable IDs 164 state = nf90_inq_varids(ncid_in,nvars,varids_in) 165 if (state /= nf90_noerr) call handle_err(state) 166 167 ! Loop over each variable to define it in the output 98 168 do i = 1,nvars 99 state = nf90_inquire_variable(ncid1,varids(i),name = namevar,xtype = xtype_var,ndims = numdims,natts = numatts) 100 write(*,*) 'Treatment of '//namevar 101 if (state /= nf90_noerr) call handle_err(state) 102 allocate(dimid_var(numdims)) 103 state = nf90_inquire_variable(ncid1,varids(i),name = namevar,xtype = xtype_var,ndims = numdims,dimids = dimid_var,natts = numatts) 104 if (state /= nf90_noerr) call handle_err(state) 105 if (numdims == 1) then 106 if (namevar == "lon") then 107 allocate(tempvalues_1d(len_lon)) 108 allocate(values_1d(len_lon + 1)) 109 state = nf90_get_var(ncid1,varids(i),tempvalues_1d) 110 if (state /= nf90_noerr) call handle_err(state) 111 state = nf90_def_var(ncid2,namevar,xtype_var,dimid_var,varids_2(i)) 112 if (state /= nf90_noerr) call handle_err(state) 113 values_1d(1:len_lon) = tempvalues_1d(:) 114 values_1d(len_lon + 1) = values_1d(1) 115 state = nf90_enddef(ncid2) 116 if (state /= nf90_noerr) call handle_err(state) 117 state = nf90_put_var(ncid2, varids_2(i), values_1d) 118 if (state /= nf90_noerr) call handle_err(state) 119 state = nf90_redef(ncid2) 120 if (state /= nf90_noerr) call handle_err(state) 121 deallocate(tempvalues_1d) 122 deallocate(values_1d) 123 else 124 state = nf90_inquire_dimension(ncid1,dimid_var(1),name_,len_) 125 if (state /= nf90_noerr) call handle_err(state) 126 allocate(tempvalues_1d(len_)) 127 state = nf90_get_var(ncid1,varids(i),tempvalues_1d) 128 if (state /= nf90_noerr) call handle_err(state) 129 state = nf90_def_var(ncid2,namevar,xtype_var,dimid_var,varids_2(i)) 130 if (state /= nf90_noerr) call handle_err(state) 131 state = nf90_enddef(ncid2) 132 if (state /= nf90_noerr) call handle_err(state) 133 state = nf90_put_var(ncid2, varids_2(i), tempvalues_1d) 134 if (state /= nf90_noerr) call handle_err(state) 135 state = nf90_redef(ncid2) 136 if (state /= nf90_noerr) call handle_err(state) 137 deallocate(tempvalues_1d) 138 endif 139 else if (numdims == 2) then 140 if (namevar == "area") then 141 allocate(tempvalues_2d(len_lon,len_lat)) 142 allocate(values_2d(len_lon + 1,len_lat)) 143 state = nf90_get_var(ncid1,varids(i),tempvalues_2d) 144 if (state /= nf90_noerr) call handle_err(state) 145 state = nf90_def_var(ncid2,namevar,xtype_var,dimid_var,varids_2(i)) 146 if (state /= nf90_noerr) call handle_err(state) 147 values_2d(1:len_lon,:) = tempvalues_2d(:,:) 148 values_2d(len_lon+1,:) = values_2d(1,:) 149 state = nf90_enddef(ncid2) 150 if (state /= nf90_noerr) call handle_err(state) 151 state = nf90_put_var(ncid2,varids_2(i),values_2d) 152 if (state /= nf90_noerr) call handle_err(state) 153 state = nf90_redef(ncid2) 154 if (state /= nf90_noerr) call handle_err(state) 155 deallocate(tempvalues_2d) 156 deallocate(values_2d) 157 else 158 state = nf90_inquire_dimension(ncid1,dimid_var(1),name_,len_1) 159 if (state /= nf90_noerr) call handle_err(state) 160 state = nf90_inquire_dimension(ncid1,dimid_var(2),name_,len_2) 161 if (state /= nf90_noerr) call handle_err(state) 162 allocate(tempvalues_2d(len_1,len_2)) 163 state = nf90_get_var(ncid1, varids(i), tempvalues_2d) 164 if (state /= nf90_noerr) call handle_err(state) 165 state = nf90_def_var(ncid2,namevar,xtype_var,dimid_var,varids_2(i)) 166 if (state /= nf90_noerr) call handle_err(state) 167 state = nf90_enddef(ncid2) 168 if (state /= nf90_noerr) call handle_err(state) 169 state = nf90_put_var(ncid2, varids_2(i), tempvalues_2d) 170 if (state /= nf90_noerr) call handle_err(state) 171 state = nf90_redef(ncid2) 172 if (state /= nf90_noerr) call handle_err(state) 173 deallocate(tempvalues_2d) 174 endif 175 else if (numdims == 3) then 176 allocate(tempvalues_3d(len_lon,len_lat,len_time)) 177 allocate(values_3d(len_lon + 1,len_lat,len_time)) 178 state = nf90_get_var(ncid1,varids(i),tempvalues_3d) 179 if (state /= nf90_noerr) call handle_err(state) 180 state = nf90_def_var(ncid2,namevar,xtype_var,dimid_var,varids_2(i)) 181 if (state /= nf90_noerr) call handle_err(state) 182 values_3d(1:len_lon,:,:) = tempvalues_3d(:,:,:) 183 values_3d(len_lon+1,:,:) = values_3d(1,:,:) 184 state = nf90_enddef(ncid2) 185 if (state /= nf90_noerr) call handle_err(state) 186 state = nf90_put_var(ncid2, varids_2(i), values_3d) 187 if (state /= nf90_noerr) call handle_err(state) 188 state = nf90_redef(ncid2) 189 if (state /= nf90_noerr) call handle_err(state) 190 deallocate(tempvalues_3d) 191 deallocate(values_3d) 192 else if (numdims == 4) then 193 allocate(tempvalues_4d(len_lon,len_lat,len_soil,len_time)) 194 allocate(values_4d(len_lon+1,len_lat,len_soil,len_time)) 195 state = nf90_get_var(ncid1, varids(i), tempvalues_4d) 196 if (state /= nf90_noerr) call handle_err(state) 197 state = nf90_def_var(ncid2, namevar, xtype_var, dimid_var, varids_2(i)) 198 if (state /= nf90_noerr) call handle_err(state) 199 state = nf90_enddef(ncid2) 200 values_4d(1:len_lon,:,:,:) = tempvalues_4d(:,:,:,:) 201 values_4d(len_lon+1,:,:,:) = values_4d(1,:,:,:) 202 if (state /= nf90_noerr) call handle_err(state) 203 state = nf90_put_var(ncid2, varids_2(i), values_4d) 204 if (state /= nf90_noerr) call handle_err(state) 205 state = nf90_redef(ncid2) 206 if (state /= nf90_noerr) call handle_err(state) 207 deallocate(tempvalues_4d) 208 deallocate(values_4d) 169 ! Inquire name, xtype, ndims, natts 170 state = nf90_inquire_variable(ncid_in,varids_in(i),name = varName,xtype = xtypeVar,ndims = numDimsVar,natts = numAttsVar) 171 if (state /= nf90_noerr) call handle_err(state) 172 write(*,*) 'Treatment of '//varName 173 174 allocate(dimids_var_in(numDimsVar)) 175 state = nf90_inquire_variable(ncid_in,varids_in(i),name = varName,xtype = xtypeVar,ndims = numDimsVar,dimids = dimids_var_in,natts = numAttsVar) 176 if (state /= nf90_noerr) call handle_err(state) 177 178 ! Detect if this variable first dimension is "lon" 179 if (numDimsVar >= 1 .and. dimids_var_in(1) == dimids_in(idx_lon_in)) then 180 uses_lon_first = .true. 181 else 182 uses_lon_first = .false. 209 183 endif 210 deallocate(dimid_var) 184 185 ! Build the output‐dimids list: replace the first dim with the output lon if needed 186 if (uses_lon_first) dimids_var_in(1) = dimids_out(idx_lon_in) 187 do j = 2,numDimsVar 188 ! Map each subsequent input dim to its output dim 189 do k = 1,ndims 190 if (dimids_var_in(j) == dimids_in(k)) then 191 dimids_var_in(j) = dimids_out(k) 192 exit 193 endif 194 enddo 195 enddo 196 197 ! Define this variable (same name, same xtype, but new dimids) 198 state = nf90_def_var(ncid_out,trim(varName),xtypeVar,dimids_var_in,varids_out(i)) 199 if (state /= nf90_noerr) call handle_err(state) 200 201 deallocate(dimids_var_in) 211 202 enddo 212 203 213 state = nf90_enddef(ncid2) 214 if (state /= nf90_noerr) call handle_err(state) 215 state = nf90_close(ncid1) 216 if (state /= nf90_noerr) call handle_err(state) 217 state = nf90_close(ncid2) 218 if (state /= nf90_noerr) call handle_err(state) 219 220 deallocate(dimids,varids,dimids_2,varids_2) 221 write(*,*) '> "data2reshape_Y'//str//'.nc" processed!' 204 ! Done defining all dims and vars exit define mode exactly once 205 state = nf90_enddef(ncid_out) 206 if (state /= nf90_noerr) call handle_err(state) 207 208 ! Loop over each variable to read from input and write to output 209 do i = 1,nvars 210 ! Re‐inquire metadata so we know dimids_var_in and numDimsVar 211 state = nf90_inquire_variable(ncid_in,varids_in(i),name = varName,xtype = xtypeVar,ndims = numDimsVar,natts = numAttsVar) 212 if (state /= nf90_noerr) call handle_err(state) 213 214 allocate(dimids_var_in(numDimsVar)) 215 state = nf90_inquire_variable(ncid_in, varids_in(i),name = varName,xtype = xtypeVar,ndims = numDimsVar,dimids = dimids_var_in,natts = numAttsVar) 216 if (state /= nf90_noerr) call handle_err(state) 217 218 ! Detect again if first dim = lon 219 if (numDimsVar >= 1 .and. dimids_var_in(1) == dimids_in(idx_lon_in)) then 220 uses_lon_first = .true. 221 else 222 uses_lon_first = .false. 223 endif 224 225 select case (numDimsVar) 226 case (1) 227 if (uses_lon_first) then 228 ! 1D lon sequence: read len_lon_in, extend to len_lon_out 229 state = nf90_get_var(ncid_in,varids_in(i),buf1D_in) 230 if (state /= nf90_noerr) call handle_err(state) 231 232 buf1D_out(1:len_lon_in) = buf1D_in(1:len_lon_in) 233 buf1D_out(len_lon_out) = buf1D_in(1) ! repeat first lon at end 234 235 state = nf90_put_var(ncid_out,varids_out(i),buf1D_out) 236 if (state /= nf90_noerr) call handle_err(state) 237 238 else 239 ! Some other 1D (e.g. lat or time). Allocate exact 1D temp: 240 state = nf90_inquire_dimension(ncid_in,dimids_var_in(1),tmpDimName, thisLen) 241 if (state /= nf90_noerr) call handle_err(state) 242 243 allocate(tmp1D(thisLen)) 244 state = nf90_get_var(ncid_in,varids_in(i),tmp1D(1:thisLen)) 245 if (state /= nf90_noerr) call handle_err(state) 246 247 state = nf90_put_var(ncid_out,varids_out(i),tmp1D(1:thisLen)) 248 if (state /= nf90_noerr) call handle_err(state) 249 250 deallocate(tmp1D) 251 endif 252 253 case (2) 254 if (uses_lon_first) then 255 ! 2D with first dim = lon (len_lon_in × lenDim2) 256 state = nf90_inquire_dimension(ncid_in,dimids_var_in(2),tmpDimName,lenDim2) 257 if (state /= nf90_noerr) call handle_err(state) 258 259 state = nf90_get_var(ncid_in,varids_in(i),buf2D_in(1:len_lon_in,1:lenDim2)) 260 if (state /= nf90_noerr) call handle_err(state) 261 262 buf2D_out(1:len_lon_in,1:lenDim2) = buf2D_in(1:len_lon_in,1:lenDim2) 263 buf2D_out(len_lon_out,1:lenDim2) = buf2D_in(1,1:lenDim2) 264 265 state = nf90_put_var(ncid_out,varids_out(i),buf2D_out(1:len_lon_out,1:lenDim2)) 266 if (state /= nf90_noerr) call handle_err(state) 267 268 else 269 ! Some other 2D (no lon‐extension). Allocate exact 2D temp: 270 state = nf90_inquire_dimension(ncid_in,dimids_var_in(1),tmpDimName,len1) 271 if (state /= nf90_noerr) call handle_err(state) 272 state = nf90_inquire_dimension(ncid_in, dimids_var_in(2),tmpDimName,len2) 273 if (state /= nf90_noerr) call handle_err(state) 274 275 allocate(tmp2D(len1,len2)) 276 state = nf90_get_var(ncid_in,varids_in(i),tmp2D(1:len1,1:len2)) 277 if (state /= nf90_noerr) call handle_err(state) 278 279 state = nf90_put_var(ncid_out, varids_out(i), tmp2D(1:len1,1:len2)) 280 if (state /= nf90_noerr) call handle_err(state) 281 282 deallocate(tmp2D) 283 endif 284 285 case (3) 286 if (uses_lon_first) then 287 ! 3D with first dim = lon (len_lon_in × lenDim2 × lenDim3) 288 state = nf90_inquire_dimension(ncid_in,dimids_var_in(2),tmpDimName,lenDim2) 289 if (state /= nf90_noerr) call handle_err(state) 290 state = nf90_inquire_dimension(ncid_in,dimids_var_in(3),tmpDimName,lenDim3) 291 if (state /= nf90_noerr) call handle_err(state) 292 293 state = nf90_get_var(ncid_in,varids_in(i),buf3D_in(1:len_lon_in,1:lenDim2,1:lenDim3)) 294 if (state /= nf90_noerr) call handle_err(state) 295 296 buf3D_out(1:len_lon_in,1:lenDim2,1:lenDim3) = buf3D_in(1:len_lon_in,1:lenDim2,1:lenDim3) 297 buf3D_out(len_lon_out,1:lenDim2,1:lenDim3) = buf3D_in(1,1:lenDim2,1:lenDim3) 298 299 state = nf90_put_var(ncid_out,varids_out(i),buf3D_out(1:len_lon_out,1:lenDim2,1:lenDim3)) 300 if (state /= nf90_noerr) call handle_err(state) 301 302 else 303 ! Some other 3D (no lon‐extension). Allocate exact 3D temp: 304 state = nf90_inquire_dimension(ncid_in,dimids_var_in(1),tmpDimName,len1) 305 if (state /= nf90_noerr) call handle_err(state) 306 state = nf90_inquire_dimension(ncid_in,dimids_var_in(2),tmpDimName,len2) 307 if (state /= nf90_noerr) call handle_err(state) 308 state = nf90_inquire_dimension(ncid_in,dimids_var_in(3),tmpDimName,len3) 309 if (state /= nf90_noerr) call handle_err(state) 310 311 allocate(tmp3D(len1,len2,len3)) 312 state = nf90_get_var(ncid_in,varids_in(i),tmp3D(1:len1,1:len2,1:len3)) 313 if (state /= nf90_noerr) call handle_err(state) 314 315 state = nf90_put_var(ncid_out,varids_out(i),tmp3D(1:len1,1:len2,1:len3)) 316 if (state /= nf90_noerr) call handle_err(state) 317 318 deallocate(tmp3D) 319 endif 320 321 case (4) 322 if (uses_lon_first) then ! 4D with first dim = lon (len_lon_in × lenDim2 × lenDim3 × lenDim4) 323 state = nf90_inquire_dimension(ncid_in,dimids_var_in(2),tmpDimName,lenDim2) 324 if (state /= nf90_noerr) call handle_err(state) 325 state = nf90_inquire_dimension(ncid_in,dimids_var_in(3),tmpDimName,lenDim3) 326 if (state /= nf90_noerr) call handle_err(state) 327 state = nf90_inquire_dimension(ncid_in,dimids_var_in(4),tmpDimName,lenDim4) 328 if (state /= nf90_noerr) call handle_err(state) 329 330 state = nf90_get_var(ncid_in,varids_in(i),buf4D_in(1:len_lon_in,1:lenDim2,1:lenDim3,1:lenDim4)) 331 if (state /= nf90_noerr) call handle_err(state) 332 333 buf4D_out(1:len_lon_in,1:lenDim2,1:lenDim3,1:lenDim4) = buf4D_in(1:len_lon_in, 1:lenDim2,1:lenDim3,1:lenDim4) 334 buf4D_out(len_lon_out,1:lenDim2,1:lenDim3,1:lenDim4) = buf4D_in(1,1:lenDim2,1:lenDim3,1:lenDim4) 335 336 state = nf90_put_var(ncid_out,varids_out(i),buf4D_out(1:len_lon_out,1:lenDim2,1:lenDim3,1:lenDim4)) 337 if (state /= nf90_noerr) call handle_err(state) 338 339 else ! Some other 4D (no lon‐extension). Allocate exact 4D temp: 340 state = nf90_inquire_dimension(ncid_in, dimids_var_in(1),tmpDimName,len1) 341 if (state /= nf90_noerr) call handle_err(state) 342 state = nf90_inquire_dimension(ncid_in, dimids_var_in(2),tmpDimName,len2) 343 if (state /= nf90_noerr) call handle_err(state) 344 state = nf90_inquire_dimension(ncid_in, dimids_var_in(3),tmpDimName,len3) 345 if (state /= nf90_noerr) call handle_err(state) 346 state = nf90_inquire_dimension(ncid_in, dimids_var_in(4),tmpDimName,len4) 347 if (state /= nf90_noerr) call handle_err(state) 348 349 allocate(tmp4D(len1,len2,len3,len4)) 350 state = nf90_get_var(ncid_in,varids_in(i),tmp4D(1:len1,1:len2,1:len3,1:len4)) 351 if (state /= nf90_noerr) call handle_err(state) 352 353 state = nf90_put_var(ncid_out,varids_out(i),tmp4D(1:len1,1:len2,1:len3,1:len4)) 354 if (state /= nf90_noerr) call handle_err(state) 355 356 deallocate(tmp4D) 357 endif 358 359 case default 360 cycle ! Skip variables with 0 dims 361 end select 362 363 deallocate(dimids_var_in) 364 enddo 365 366 ! Close both NetCDF files 367 state = nf90_close(ncid_in) 368 if (state /= nf90_noerr) call handle_err(state) 369 state = nf90_close(ncid_out) 370 if (state /= nf90_noerr) call handle_err(state) 371 372 ! Deallocate everything 373 deallocate(dimids_in,dimids_out,varids_in,varids_out,dimNames,dimLens) 374 deallocate(buf1D_in,buf1D_out,buf2D_in,buf2D_out,buf3D_in,buf3D_out,buf4D_in,buf4D_out) 375 376 write(*,*) "> ""data2reshape_Y"//trim(str)//".nc"" processed!" 222 377 enddo 223 378
Note: See TracChangeset
for help on using the changeset viewer.
