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

Last change on this file since 3116 was 3106, checked in by jbclement, 21 months ago

PEM:

  • Correction of a bug when running with ifort, XIOS and no sub-slopes. If compiled with ifort, the 'Reshape' program cashed because of sub-slopes variables were written in the XIOS output but not filled. A new file definition without sub-slopes can be chosen in the xml file to avoid this issue.
  • Addition in the 'Reshape' program of a check to remove the output files if they exist to prevent a crash.

JBC
File size: 10.0 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
[2850]13
[3076]14implicit none
[2850]15
[3076]16integer                               :: state, ncid, ncid1, ncid2, nDims, nVars, nGlobalAtts, unlimDimID
[3106]17integer                               :: i, j, include_parents, cstat
[3076]18integer, dimension(:),    allocatable :: dimids, varids, dimids_2, varids_2, dimid_var
19real, dimension(:),       allocatable :: tempvalues_1d, values_1d
20real, dimension(:,:),     allocatable :: tempvalues_2d, values_2d
21real, dimension(:,:,:),   allocatable :: tempvalues_3d, values_3d
22real, dimension(:,:,:,:), allocatable :: tempvalues_4d, values_4d
[3106]23character(1)                          :: str
[3076]24character(30)                         :: name_, namevar
25integer                               :: xtype_var, len_, len_1, len_2, len_lat, len_lon, len_time, len_soil
26integer                               :: dimid_lon, dimid_lat, dimid_time, dimid_soil, dimid_2, numdims, numatts, numyear
[3106]27logical                               :: yes
[2850]28
[3076]29do numyear = 1,2
30    write(*,*) 'numyear',numyear
[3106]31    write(str(1:1),'(i1.1)') numyear
[3076]32    !nf90_open                 ! open existing netCDF dataset
33    !integer :: ncid, state
34    !...
[3106]35    state = nf90_open(path = "data2reshape"//str//".nc", mode = nf90_nowrite, ncid = ncid1)
[3076]36    if (state /= nf90_noerr) call handle_err(state)
[2850]37
[3106]38    inquire(file = 'data_PCM_Y'//str//'.nc', exist = yes)
39    if (yes) then
40        call execute_command_line('rm data_PCM_Y'//str//'.nc',cmdstat = cstat)
41        if (cstat > 0) then
42            error stop 'Command exection failed!'
43        else if (cstat < 0) then
44            error stop 'Command execution not supported!'
45        endif
46    endif
47    state = nf90_create(path = "data_PCM_Y"//str//".nc", cmode=or(nf90_noclobber,nf90_64bit_offset), ncid = ncid2)
[3076]48    if (state /= nf90_noerr) call handle_err(state)
[2850]49
[3076]50    state = nf90_inquire(ncid1, ndims, nvars, nglobalatts, unlimdimid)
51    if (state /= nf90_noerr) call handle_err(state)
[2850]52
[3076]53    allocate(dimids(ndims))
54    allocate(varids(nvars))
[2850]55
[3076]56    allocate(dimids_2(ndims))
57    allocate(varids_2(nvars))
[2850]58
[3076]59    state = nf90_inq_dimids(ncid1, ndims, dimids, include_parents)
60    if (state /= nf90_noerr) call handle_err(state)
61    state = nf90_inq_varids(ncid1, nvars, varids)
62    if (state /= nf90_noerr) call handle_err(state)
[2850]63
[3076]64    do i = 1,ndims
65        state = nf90_inquire_dimension(ncid1, dimids(i), name_, len_)
66        if (state /= nf90_noerr) call handle_err(state)
67        if (name_ == "lon" .or. name_ == "longitude") then
68            dimid_lon = dimids(i)
69            len_lon = len_
70            len_ = len_ + 1
71        elseif (name_ == "lat".or. name_ == "latitude") then
72            dimid_lat=dimids(i)
73            len_lat=len_
74        elseif (name_ == "time_counter".or. name_ ==  "Time") then
75            dimid_time=dimids(i)
76            len_time=len_
77        elseif (name_ == "soil_layers".or. name_ ==  "subsurface_layers") then
78            dimid_soil=dimids(i)
79            len_soil = len_
80        endif
81        state = nf90_def_dim(ncid2, name_,len_,dimid_2)
82        if (state /= nf90_noerr) call handle_err(state)
83        dimids_2(i) = dimid_2
84    enddo
[2850]85
[3076]86    do i = 1,nvars
87        state = nf90_inquire_variable(ncid1, varids(i),name = namevar,xtype = xtype_var,ndims = numdims,natts = numatts)
88        write(*,*) "namevar00= ", namevar
89        if (state /= nf90_noerr) call handle_err(state)
90        allocate(dimid_var(numdims))
91        state = nf90_inquire_variable(ncid1,varids(i),name = namevar,xtype = xtype_var,ndims = numdims,dimids = dimid_var,natts = numatts)
92        if (state /= nf90_noerr) call handle_err(state)
93        if (numdims == 1) then
94            if (namevar == "lon") then
95                allocate(tempvalues_1d(len_lon))
96                allocate(values_1d(len_lon + 1))
97                state = nf90_get_var(ncid1,varids(i),tempvalues_1d)
98                if (state /= nf90_noerr) call handle_err(state)
99                state = nf90_def_var(ncid2,namevar,xtype_var, dimid_var, varids_2(i))
100                if (state /= nf90_noerr) call handle_err(state)
101                values_1d(1:len_lon) = tempvalues_1d(:)
102                values_1d(len_lon + 1) = values_1d(1)
103                state = nf90_enddef(ncid2)
104                if (state /= nf90_noerr) call handle_err(state)
105                state = nf90_put_var(ncid2, varids_2(i), values_1d)
106                if (state /= nf90_noerr) call handle_err(state)
107                state = nf90_redef(ncid2)
108                if (state /= nf90_noerr) call handle_err(state)
109                deallocate(tempvalues_1d)
110                deallocate(values_1d)
111            else
112                state = nf90_inquire_dimension(ncid1,dimid_var(1),name_,len_)
113                if (state /= nf90_noerr) call handle_err(state)
114                allocate(tempvalues_1d(len_))
115                state = nf90_get_var(ncid1,varids(i),tempvalues_1d)
116                if (state /= nf90_noerr) call handle_err(state)
117                state = nf90_def_var(ncid2,namevar,xtype_var,dimid_var,varids_2(i))
118                if (state /= nf90_noerr) call handle_err(state)
119                state = nf90_enddef(ncid2)
120                if (state /= nf90_noerr) call handle_err(state)
121                state = nf90_put_var(ncid2, varids_2(i), tempvalues_1d)
122                if (state /= nf90_noerr) call handle_err(state)
123                state = nf90_redef(ncid2)
124                if (state /= nf90_noerr) call handle_err(state)
125                deallocate(tempvalues_1d)
126            endif
127        else if (numdims == 2) then
128            if (namevar == "area") then
129                allocate(tempvalues_2d(len_lon,len_lat))
130                allocate(values_2d(len_lon + 1,len_lat))
131                state = nf90_get_var(ncid1,varids(i),tempvalues_2d)
132                if (state /= nf90_noerr) call handle_err(state)
133                state = nf90_def_var(ncid2,namevar,xtype_var,dimid_var,varids_2(i))
134                if (state /= nf90_noerr) call handle_err(state)
135                values_2d(1:len_lon,:) = tempvalues_2d(:,:)
136                values_2d(len_lon+1,:) = values_2d(1,:)
137                state = nf90_enddef(ncid2)
138                if (state /= nf90_noerr) call handle_err(state)
139                state = nf90_put_var(ncid2,varids_2(i),values_2d)
140                if (state /= nf90_noerr) call handle_err(state)
141                state = nf90_redef(ncid2)
142                if (state /= nf90_noerr) call handle_err(state)
143                deallocate(tempvalues_2d)
144                deallocate(values_2d)
145            else
146                state = nf90_inquire_dimension(ncid1,dimid_var(1),name_,len_1)
147                if (state /= nf90_noerr) call handle_err(state)
148                state = nf90_inquire_dimension(ncid1,dimid_var(2),name_,len_2)
149                if (state /= nf90_noerr) call handle_err(state)
150                allocate(tempvalues_2d(len_1,len_2))
151                state = nf90_get_var(ncid1, varids(i), tempvalues_2d)
152                if (state /= nf90_noerr) call handle_err(state)
153                state = nf90_def_var(ncid2,namevar,xtype_var,dimid_var,varids_2(i))
154                if (state /= nf90_noerr) call handle_err(state)
155                state = nf90_enddef(ncid2)
156                if (state /= nf90_noerr) call handle_err(state)
157                state = nf90_put_var(ncid2, varids_2(i), tempvalues_2d)
158                if (state /= nf90_noerr) call handle_err(state)
159                state = nf90_redef(ncid2)
160                if (state /= nf90_noerr) call handle_err(state)
161                deallocate(tempvalues_2d)
162            endif
163        elseif (numdims == 3) then
164            allocate(tempvalues_3d(len_lon,len_lat,len_time))
165            allocate(values_3d(len_lon + 1,len_lat,len_time))
166            state = nf90_get_var(ncid1,varids(i),tempvalues_3d)
167            if (state /= nf90_noerr) call handle_err(state)
168            state = nf90_def_var(ncid2,namevar,xtype_var,dimid_var,varids_2(i))
169            if (state /= nf90_noerr) call handle_err(state)
170            values_3d(1:len_lon,:,:) = tempvalues_3d(:,:,:)
171            values_3d(len_lon+1,:,:) = values_3d(1,:,:)
172            state = nf90_enddef(ncid2)
173            if (state /= nf90_noerr) call handle_err(state)
174            state = nf90_put_var(ncid2, varids_2(i), values_3d)
175            if (state /= nf90_noerr) call handle_err(state)
176            state = nf90_redef(ncid2)
177            if (state /= nf90_noerr) call handle_err(state)
178            deallocate(tempvalues_3d)
179            deallocate(values_3d)
180        else if (numdims == 4) then
181            allocate(tempvalues_4d(len_lon,len_lat,len_soil,len_time))
182            allocate(values_4d(len_lon+1,len_lat,len_soil,len_time))
183            state = nf90_get_var(ncid1, varids(i), tempvalues_4d)
184            if (state /= nf90_noerr) call handle_err(state)
185            state = nf90_def_var(ncid2, namevar, xtype_var, dimid_var, varids_2(i))
186            if (state /= nf90_noerr) call handle_err(state)
187            state = nf90_enddef(ncid2)
188            values_4d(1:len_lon,:,:,:) = tempvalues_4d(:,:,:,:)
189            values_4d(len_lon+1,:,:,:) = values_4d(1,:,:,:)
190            if (state /= nf90_noerr) call handle_err(state)
191            state = nf90_put_var(ncid2, varids_2(i), values_4d)
192            if (state /= nf90_noerr) call handle_err(state)
193            state = nf90_redef(ncid2)
194            if (state /= nf90_noerr) call handle_err(state)
195            deallocate(tempvalues_4d)
196            deallocate(values_4d)
197        endif
198        deallocate(dimid_var)
199    enddo
[2850]200
[3076]201    state = nf90_enddef(ncid2)
202    if (state /= nf90_noerr) call handle_err(state)
203    state = nf90_close(ncid1)
204    if (state /= nf90_noerr) call handle_err(state)
205    state = nf90_close(ncid2)
206    if (state /= nf90_noerr) call handle_err(state)
[2850]207
[3076]208    deallocate(dimids,varids,dimids_2,varids_2)
[2850]209enddo
210
[3076]211END PROGRAM reshape_XIOS_output
[2850]212
Note: See TracBrowser for help on using the repository browser.