source: trunk/LMDZ.COMMON/libf/evolution/reshape_XIOS_output.F90 @ 3584

Last change on this file since 3584 was 3584, checked in by jbclement, 2 weeks ago

PEM:

  • Albedo is now updated only at the end of the PEM (and not at every iteration) + Correct way to set it taking into account CO2/H2O ice and frost.
  • Cosmetic cleanings.

JBC
File size: 10.5 KB
RevLine 
[3076]1PROGRAM reshape_XIOS_output
[2855]2
3!=======================================================================
4!
[3096]5! Purpose: Read XIOS files, and convert them into the correct PCM grid
[2855]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
[3096]8!          over the two PCM runs
[2855]9!
10! Authors: RV & LL
11!=======================================================================
[3076]12use netcdf
[3579]13use version_info_mod, only: print_version_info
[2850]14
[3076]15implicit none
[2850]16
[3214]17integer                               :: state, ncid1, ncid2, nDims, nVars, nGlobalAtts, unlimDimID
18integer                               :: i, include_parents, cstat
[3076]19integer, dimension(:),    allocatable :: dimids, varids, dimids_2, varids_2, dimid_var
20real, dimension(:),       allocatable :: tempvalues_1d, values_1d
21real, dimension(:,:),     allocatable :: tempvalues_2d, values_2d
22real, dimension(:,:,:),   allocatable :: tempvalues_3d, values_3d
23real, dimension(:,:,:,:), allocatable :: tempvalues_4d, values_4d
[3106]24character(1)                          :: str
[3076]25character(30)                         :: name_, namevar
[3579]26character(100)                        :: arg ! To read command-line arguments
[3076]27integer                               :: xtype_var, len_, len_1, len_2, len_lat, len_lon, len_time, len_soil
28integer                               :: dimid_lon, dimid_lat, dimid_time, dimid_soil, dimid_2, numdims, numatts, numyear
[3106]29logical                               :: yes
[2850]30
[3579]31
32if (command_argument_count() > 0) then ! Get the number of command-line arguments
33    call get_command_argument(1,arg) ! Read the argument given to the program
34    select case (trim(adjustl(arg)))
35        case('version')
36            call print_version_info()
37            stop
38        case default
39            error stop 'The argument given to the program is unknown!'
40    end select
41endif
42
[3076]43do numyear = 1,2
[3584]44    write(str,'(i1.1)') numyear
45    write(*,*) 'Reshaping of variables from "data2reshape_Y'//str//'.nc"...'
[3181]46
[3584]47    state = nf90_open(path = "data2reshape_Y"//str//".nc",mode = nf90_nowrite,ncid = ncid1)
[3076]48    if (state /= nf90_noerr) call handle_err(state)
[2850]49
[3106]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)
53        if (cstat > 0) then
54            error stop 'Command exection failed!'
55        else if (cstat < 0) then
56            error stop 'Command execution not supported!'
57        endif
58    endif
[3584]59    state = nf90_create(path = "data_PCM_Y"//str//".nc",cmode = or(nf90_noclobber,nf90_64bit_offset),ncid = ncid2)
[3076]60    if (state /= nf90_noerr) call handle_err(state)
[2850]61
[3076]62    state = nf90_inquire(ncid1, ndims, nvars, nglobalatts, unlimdimid)
63    if (state /= nf90_noerr) call handle_err(state)
[2850]64
[3076]65    allocate(dimids(ndims))
66    allocate(varids(nvars))
[2850]67
[3076]68    allocate(dimids_2(ndims))
69    allocate(varids_2(nvars))
[2850]70
[3584]71    state = nf90_inq_dimids(ncid1,ndims,dimids,include_parents)
[3076]72    if (state /= nf90_noerr) call handle_err(state)
[3584]73    state = nf90_inq_varids(ncid1,nvars,varids)
[3076]74    if (state /= nf90_noerr) call handle_err(state)
[2850]75
[3076]76    do i = 1,ndims
[3584]77        state = nf90_inquire_dimension(ncid1,dimids(i),name_,len_)
[3076]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
[3181]83        else if (name_ == "lat".or. name_ == "latitude") then
[3584]84            dimid_lat = dimids(i)
85            len_lat = len_
[3181]86        else if (name_ == "time_counter".or. name_ ==  "Time") then
[3584]87            dimid_time = dimids(i)
88            len_time = len_
[3181]89        else if (name_ == "soil_layers".or. name_ ==  "subsurface_layers") then
[3584]90            dimid_soil = dimids(i)
[3076]91            len_soil = len_
92        endif
[3584]93        state = nf90_def_dim(ncid2,name_,len_,dimid_2)
[3076]94        if (state /= nf90_noerr) call handle_err(state)
95        dimids_2(i) = dimid_2
96    enddo
[2850]97
[3076]98    do i = 1,nvars
[3584]99        state = nf90_inquire_variable(ncid1,varids(i),name = namevar,xtype = xtype_var,ndims = numdims,natts = numatts)
100        write(*,*) '> Treatment of '//namevar
[3076]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)
[3584]111                state = nf90_def_var(ncid2,namevar,xtype_var,dimid_var,varids_2(i))
[3076]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
[3181]175        else if (numdims == 3) then
[3076]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)
209        endif
210        deallocate(dimid_var)
211    enddo
[2850]212
[3076]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)
[2850]219
[3076]220    deallocate(dimids,varids,dimids_2,varids_2)
[3584]221    write(*,*) 'Done!'
[2850]222enddo
223
[3076]224END PROGRAM reshape_XIOS_output
Note: See TracBrowser for help on using the repository browser.