2 |
|
|
3 |
! From flincom.f90, version 2.2 2006/03/07 09:21:51 |
! From flincom.f90, version 2.2 2006/03/07 09:21:51 |
4 |
|
|
|
USE netcdf |
|
|
|
|
|
USE calendar, ONLY : ju2ymds, ymds2ju, ioconf_calendar |
|
|
USE errioipsl, ONLY : histerr |
|
|
USE stringop, ONLY : strlowercase |
|
|
|
|
5 |
IMPLICIT NONE |
IMPLICIT NONE |
6 |
|
|
7 |
PRIVATE |
PRIVATE |
8 |
PUBLIC flinput, flincre, flinget, flinget_zoom2d, flinclo |
PUBLIC flinclo, flinopen_nozoom, flininfo, ncids |
|
public flinopen_nozoom |
|
|
public flininfo, flininspect, flinquery_var |
|
|
|
|
|
INTERFACE flinput |
|
|
!--------------------------------------------------------------------- |
|
|
!- The "flinput" routines will put a variable |
|
|
!- on the netCDF file created by flincre. |
|
|
!- If the sizes of the axis do not match the one of the IDs |
|
|
!- then a new axis is created. |
|
|
!- That is we loose the possibility of writting hyperslabs of data. |
|
|
|
|
|
!- Again here if iim = jjm = llm = ttm = 0 |
|
|
!- then a global attribute is added to the file. |
|
|
|
|
|
!- INPUT |
|
|
|
|
|
!- fid : Identification of the file in which we will write |
|
|
!- varname : Name of variable to be written |
|
|
!- iim : size in x of variable |
|
|
!- nlonid : ID of x axis which could fit for this axis |
|
|
!- jjm : size in y of variable |
|
|
!- nlatid : ID of y axis which could fit for this axis |
|
|
!- llm : size in z of variable |
|
|
!- zdimid : ID of z axis which could fit for this axis |
|
|
!- ttm : size in t of variable |
|
|
!- tdimid : ID of t axis which could fit for this axis |
|
|
|
|
|
!- OUTPUT |
|
|
|
|
|
!- NONE |
|
|
!--------------------------------------------------------------------- |
|
|
MODULE PROCEDURE flinput_r4d, flinput_r3d, flinput_r2d, & |
|
|
flinput_r1d, flinput_scal |
|
|
END INTERFACE |
|
|
|
|
|
INTERFACE flinget |
|
|
MODULE PROCEDURE flinget_r4d, flinget_r3d, flinget_r2d, flinget_r1d, & |
|
|
flinget_scal |
|
|
END INTERFACE |
|
|
INTERFACE flinget_zoom2d |
|
|
MODULE PROCEDURE flinget_r4d_zoom2d, flinget_r3d_zoom2d, & |
|
|
flinget_r2d_zoom2d |
|
|
END INTERFACE |
|
|
|
|
|
! This is the data we keep on each file we open |
|
|
|
|
|
INTEGER, PARAMETER :: nbfile_max = 200 |
|
|
INTEGER, SAVE :: nbfiles = 0 |
|
|
INTEGER, SAVE :: ncids(nbfile_max), ncnbd(nbfile_max), & |
|
|
ncfunli(nbfile_max), ncnba(nbfile_max) |
|
|
INTEGER, SAVE :: ncnbva(nbfile_max), ncdims(nbfile_max,4) |
|
|
LOGICAL, SAVE :: ncfileopen(nbfile_max)=.FALSE. |
|
9 |
|
|
10 |
INTEGER, SAVE :: cind_vid, cind_fid, cind_len |
! This is the data we keep on each file we open: |
11 |
INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: cindex |
INTEGER, PARAMETER:: nbfile_max = 200 |
12 |
|
INTEGER, SAVE:: ncids(nbfile_max) |
13 |
INTEGER,DIMENSION(4) :: w_sta, w_len, w_dim |
INTEGER, SAVE:: ncnbva(nbfile_max) |
14 |
|
LOGICAL, SAVE:: ncfileopen(nbfile_max)=.FALSE. |
15 |
|
|
16 |
CONTAINS |
CONTAINS |
17 |
|
|
18 |
SUBROUTINE flincre & |
SUBROUTINE flinopen_nozoom(iim, jjm, llm, lon, lat, lev, & |
|
(filename, iim1, jjm1, lon1, lat1, llm1, lev1, ttm1, itaus, & |
|
|
time0, dt, fid_out, nlonid1, nlatid1, zdimid1, tdimid1) |
|
|
!--------------------------------------------------------------------- |
|
|
!- This is a "low level" subroutine for opening netCDF files wich |
|
|
!- contain the major coordinate system of the model. |
|
|
!- Other coordinates needed for other variables |
|
|
!- will be added as they are needed. |
|
|
|
|
|
!- INPUT |
|
|
|
|
|
!- filename : Name of the file to be created |
|
|
!- iim1, jjm1 : Horizontal size of the grid |
|
|
!- which will be stored in the file |
|
|
!- lon1, lat1 : Horizontal grids |
|
|
!- llm1 : Size of the vertical grid |
|
|
!- lev1 : Vertical grid |
|
|
!- ttm1 : Size of time axis |
|
|
!- itaus : time steps on the time axis |
|
|
!- time0 : Time in julian days at which itau = 0 |
|
|
!- dt : time step in seconds between itaus |
|
|
!- (one step of itau) |
|
|
|
|
|
!- OUTPUT |
|
|
|
|
|
!- fid : File identification |
|
|
!- nlonid1 : Identification of longitudinal axis |
|
|
!- nlatid1 : Identification of latitudinal axis |
|
|
!- zdimid1 : ID of vertical axis |
|
|
!- tdimid1 : ID of time axis |
|
|
!--------------------------------------------------------------------- |
|
|
IMPLICIT NONE |
|
|
|
|
|
! ARGUMENTS |
|
|
|
|
|
CHARACTER(LEN=*) :: filename |
|
|
INTEGER :: iim1, jjm1, llm1, ttm1 |
|
|
REAL :: lon1(iim1,jjm1) |
|
|
REAL :: lat1(iim1,jjm1) |
|
|
REAL :: lev1(llm1) |
|
|
INTEGER :: itaus(ttm1) |
|
|
REAL :: time0 |
|
|
REAL :: dt |
|
|
INTEGER :: fid_out, zdimid1, nlonid1, nlatid1, tdimid1 |
|
|
|
|
|
! LOCAL |
|
|
|
|
|
INTEGER :: iret, lll, fid |
|
|
INTEGER :: lonid, latid, levid, timeid |
|
|
INTEGER :: year, month, day |
|
|
REAL :: sec |
|
|
CHARACTER(LEN=250):: name |
|
|
|
|
|
LOGICAL :: check = .FALSE. |
|
|
!--------------------------------------------------------------------- |
|
|
lll = LEN_TRIM(filename) |
|
|
IF (filename(lll-2:lll) /= '.nc') THEN |
|
|
name=filename(1:lll)//'.nc' |
|
|
ELSE |
|
|
name=filename(1:lll) |
|
|
ENDIF |
|
|
|
|
|
iret = NF90_CREATE (name, NF90_CLOBBER, fid) |
|
|
|
|
|
iret = NF90_DEF_DIM (fid, 'x', iim1, nlonid1) |
|
|
iret = NF90_DEF_DIM (fid, 'y', jjm1, nlatid1) |
|
|
iret = NF90_DEF_DIM (fid, 'lev', llm1, zdimid1) |
|
|
iret = NF90_DEF_DIM (fid, 'tstep', ttm1, tdimid1) |
|
|
|
|
|
! Vertical axis |
|
|
|
|
|
IF (check) WRITE(*,*) 'flincre Vertical axis' |
|
|
|
|
|
iret = NF90_DEF_VAR (fid, 'lev', NF90_FLOAT, zdimid1, levid) |
|
|
iret = NF90_PUT_ATT (fid, levid, 'units', '-') |
|
|
iret = NF90_PUT_ATT (fid, levid, 'title', 'levels') |
|
|
iret = NF90_PUT_ATT (fid, levid, 'long_name', 'Sigma Levels') |
|
|
|
|
|
! Time axis |
|
|
|
|
|
IF (check) WRITE(*,*) 'flincre time axis' |
|
|
|
|
|
iret = NF90_DEF_VAR (fid, 'tstep', NF90_FLOAT, tdimid1, timeid) |
|
|
iret = NF90_PUT_ATT (fid, timeid, 'units', '-') |
|
|
iret = NF90_PUT_ATT (fid, timeid, 'title', 'time') |
|
|
iret = NF90_PUT_ATT (fid, timeid, 'long_name', 'time steps') |
|
|
|
|
|
! The longitude |
|
|
|
|
|
IF (check) WRITE(*,*) 'flincre Longitude axis' |
|
|
|
|
|
iret = NF90_DEF_VAR (fid, "nav_lon", NF90_FLOAT, & |
|
|
(/ nlonid1, nlatid1 /), lonid) |
|
|
iret = NF90_PUT_ATT (fid, lonid, 'units', "degrees_east") |
|
|
iret = NF90_PUT_ATT (fid, lonid, 'title', "Longitude") |
|
|
iret = NF90_PUT_ATT (fid, lonid, 'nav_model', & |
|
|
"Lambert projection of PROMES") |
|
|
iret = NF90_PUT_ATT (fid, lonid, 'valid_min', & |
|
|
REAL(MINVAL(lon1))) |
|
|
iret = NF90_PUT_ATT (fid, lonid, 'valid_max', & |
|
|
REAL(MAXVAL(lon1))) |
|
|
|
|
|
! The Latitude |
|
|
|
|
|
IF (check) WRITE(*,*) 'flincre Latitude axis' |
|
|
|
|
|
iret = NF90_DEF_VAR (fid, "nav_lat", NF90_FLOAT, & |
|
|
(/ nlonid1, nlatid1 /), latid) |
|
|
iret = NF90_PUT_ATT (fid, latid, 'units', "degrees_north") |
|
|
iret = NF90_PUT_ATT (fid, latid, 'title', "Latitude") |
|
|
iret = NF90_PUT_ATT (fid, latid, 'nav_model', & |
|
|
"Lambert projection of PROMES") |
|
|
iret = NF90_PUT_ATT (fid, latid, 'valid_min', & |
|
|
REAL(MINVAL(lat1))) |
|
|
iret = NF90_PUT_ATT (fid, latid, 'valid_max', & |
|
|
REAL(MAXVAL(lat1))) |
|
|
|
|
|
! The time coordinates |
|
|
|
|
|
iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'delta_tstep_sec', & |
|
|
REAL(dt)) |
|
|
|
|
|
CALL ju2ymds (time0, year, month, day, sec) |
|
|
|
|
|
iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'year0', REAL(year)) |
|
|
iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'month0', REAL(month)) |
|
|
iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'day0', REAL(day)) |
|
|
iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'sec0', REAL(sec)) |
|
|
|
|
|
iret = NF90_ENDDEF (fid) |
|
|
|
|
|
IF (check) WRITE(*,*) 'flincre Variable' |
|
|
|
|
|
iret = NF90_PUT_VAR (fid, levid, lev1(1:llm1)) |
|
|
|
|
|
IF (check) WRITE(*,*) 'flincre Time Variable' |
|
|
|
|
|
iret = NF90_PUT_VAR (fid, timeid, REAL(itaus(1:ttm1))) |
|
|
|
|
|
IF (check) WRITE(*,*) 'flincre Longitude' |
|
|
|
|
|
iret = NF90_PUT_VAR (fid, lonid, lon1(1:iim1,1:jjm1)) |
|
|
|
|
|
IF (check) WRITE(*,*) 'flincre Latitude' |
|
|
|
|
|
iret = NF90_PUT_VAR (fid, latid, lat1(1:iim1,1:jjm1)) |
|
|
|
|
|
! Keep all this information |
|
|
|
|
|
nbfiles = nbfiles+1 |
|
|
|
|
|
IF (nbfiles > nbfile_max) THEN |
|
|
CALL histerr (3,'flincre', & |
|
|
'Too many files. Please increase nbfil_max', & |
|
|
'in program flincom.F90.',' ') |
|
|
ENDIF |
|
|
|
|
|
ncids(nbfiles) = fid |
|
|
ncnbd(nbfiles) = 4 |
|
|
|
|
|
ncdims(nbfiles,1:4) = (/ iim1, jjm1, llm1, ttm1 /) |
|
|
|
|
|
ncfunli(nbfiles) = -1 |
|
|
ncnba(nbfiles) = 4 |
|
|
ncnbva(nbfiles) = 0 |
|
|
ncfileopen(nbfiles) = .TRUE. |
|
|
|
|
|
fid_out = nbfiles |
|
|
!--------------------- |
|
|
END SUBROUTINE flincre |
|
|
|
|
|
!=== |
|
|
|
|
|
SUBROUTINE flinopen_nozoom(filename, iim, jjm, llm, lon, lat, lev, & |
|
19 |
ttm, itaus, date0, dt, fid_out) |
ttm, itaus, date0, dt, fid_out) |
20 |
|
|
21 |
!- The routine will open an input file |
!- The routine will open an input file |
22 |
!- INPUT |
!- INPUT |
|
!- filename : Name of the netCDF file to be opened |
|
|
|
|
23 |
!- There is no test of the content of the file against the input |
!- There is no test of the content of the file against the input |
24 |
! from the model |
! from the model |
25 |
|
|
51 |
|
|
52 |
!--------------------------------------------------------------------- |
!--------------------------------------------------------------------- |
53 |
|
|
54 |
|
USE calendar, ONLY : ymds2ju, ioconf_calendar |
55 |
|
USE errioipsl, ONLY : histerr |
56 |
|
USE netcdf, ONLY : nf90_get_att, nf90_get_var, nf90_global, & |
57 |
|
nf90_inquire_variable |
58 |
|
|
59 |
IMPLICIT NONE |
IMPLICIT NONE |
60 |
|
|
61 |
! ARGUMENTS |
! ARGUMENTS |
62 |
|
|
|
CHARACTER(LEN=*), intent(in):: filename |
|
63 |
INTEGER, intent(in) :: iim, jjm, llm, ttm |
INTEGER, intent(in) :: iim, jjm, llm, ttm |
64 |
real, intent(out):: lon(iim,jjm), lat(iim,jjm), lev(llm) |
real, intent(out):: lon(iim,jjm), lat(iim,jjm), lev(llm) |
65 |
INTEGER, intent(out):: itaus(ttm) |
INTEGER, intent(out):: itaus(ttm) |
73 |
INTEGER :: iret, vid, fid, nbdim, i |
INTEGER :: iret, vid, fid, nbdim, i |
74 |
INTEGER :: gdtt_id, old_id, iv, gdtmaf_id |
INTEGER :: gdtt_id, old_id, iv, gdtmaf_id |
75 |
CHARACTER(LEN=250) :: name |
CHARACTER(LEN=250) :: name |
76 |
CHARACTER(LEN=80) :: units, calendar |
CHARACTER(LEN=80) :: units, my_calendar |
77 |
INTEGER :: year, month, day |
INTEGER :: year, month, day |
78 |
REAL :: r_year, r_month, r_day |
REAL :: r_year, r_month, r_day |
79 |
INTEGER :: year0, month0, day0, hours0, minutes0, seci |
INTEGER :: year0, month0, day0, hours0, minutes0, seci |
187 |
!-- Getting all the details for the time axis |
!-- Getting all the details for the time axis |
188 |
!--- |
!--- |
189 |
!-- Find the calendar |
!-- Find the calendar |
190 |
calendar='XXXX' |
my_calendar='XXXX' |
191 |
iret = NF90_GET_ATT (fid, gdtmaf_id, 'calendar', calendar) |
iret = NF90_GET_ATT (fid, gdtmaf_id, 'calendar', my_calendar) |
192 |
IF ( INDEX(calendar,'XXXX') < 1 ) THEN |
IF ( INDEX(my_calendar,'XXXX') < 1 ) THEN |
193 |
CALL ioconf_calendar(calendar) |
CALL ioconf_calendar(my_calendar) |
194 |
ENDIF |
ENDIF |
195 |
!-- |
!-- |
196 |
units = '' |
units = '' |
237 |
!- it before in order to allocate the space needed to extract the |
!- it before in order to allocate the space needed to extract the |
238 |
!- data from the file. |
!- data from the file. |
239 |
!--------------------------------------------------------------------- |
!--------------------------------------------------------------------- |
240 |
|
USE strlowercase_m, ONLY : strlowercase |
241 |
|
USE errioipsl, ONLY : histerr |
242 |
|
USE netcdf, ONLY : nf90_inquire, nf90_inquire_dimension, nf90_noerr, & |
243 |
|
nf90_nowrite, nf90_open |
244 |
|
|
245 |
IMPLICIT NONE |
IMPLICIT NONE |
246 |
|
|
247 |
! ARGUMENTS |
! ARGUMENTS |
251 |
|
|
252 |
! LOCAL |
! LOCAL |
253 |
|
|
254 |
|
INTEGER, SAVE :: nbfiles = 0 |
255 |
|
INTEGER, SAVE :: ncdims(nbfile_max,4) |
256 |
INTEGER :: iret, fid, ndims, nvars, nb_atts, id_unlim |
INTEGER :: iret, fid, ndims, nvars, nb_atts, id_unlim |
257 |
INTEGER :: iv, lll |
INTEGER :: iv, lll |
258 |
CHARACTER(LEN=80) :: name |
CHARACTER(LEN=80) :: name |
322 |
ENDIF |
ENDIF |
323 |
|
|
324 |
ncids(nbfiles) = fid |
ncids(nbfiles) = fid |
|
ncnbd(nbfiles) = ndims |
|
|
|
|
325 |
ncdims(nbfiles,1:4) = (/ iim, jjm, llm, ttm /) |
ncdims(nbfiles,1:4) = (/ iim, jjm, llm, ttm /) |
326 |
|
|
|
ncfunli(nbfiles) = id_unlim |
|
|
ncnba(nbfiles) = nb_atts |
|
327 |
ncnbva(nbfiles) = nvars |
ncnbva(nbfiles) = nvars |
328 |
ncfileopen(nbfiles) = .TRUE. |
ncfileopen(nbfiles) = .TRUE. |
329 |
|
|
333 |
|
|
334 |
!=== |
!=== |
335 |
|
|
|
SUBROUTINE flinput_r1d & |
|
|
(fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var) |
|
|
!--------------------------------------------------------------------- |
|
|
IMPLICIT NONE |
|
|
|
|
|
INTEGER :: fid_in |
|
|
CHARACTER(LEN=*) :: varname |
|
|
INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid |
|
|
REAL :: var(:) |
|
|
|
|
|
INTEGER :: fid, ncvarid, ndim, iret |
|
|
LOGICAL :: check = .FALSE. |
|
|
!--------------------------------------------------------------------- |
|
|
IF (check) WRITE(*,*) & |
|
|
"flinput_r1d : SIZE(var) = ",SIZE(var) |
|
|
|
|
|
CALL flinput_mat & |
|
|
(fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, & |
|
|
fid,ncvarid,ndim) |
|
|
|
|
|
iret = NF90_PUT_VAR (fid, ncvarid, var, & |
|
|
start=w_sta(1:ndim), count=w_len(1:ndim)) |
|
|
!------------------------- |
|
|
END SUBROUTINE flinput_r1d |
|
|
|
|
|
!=== |
|
|
|
|
|
SUBROUTINE flinput_r2d & |
|
|
(fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var) |
|
|
!--------------------------------------------------------------------- |
|
|
IMPLICIT NONE |
|
|
|
|
|
INTEGER :: fid_in |
|
|
CHARACTER(LEN=*) :: varname |
|
|
INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid |
|
|
REAL :: var(:,:) |
|
|
|
|
|
INTEGER :: fid, ncvarid, ndim, iret |
|
|
LOGICAL :: check = .FALSE. |
|
|
!--------------------------------------------------------------------- |
|
|
IF (check) WRITE(*,*) & |
|
|
"flinput_r2d : SIZE(var) = ",SIZE(var) |
|
|
|
|
|
CALL flinput_mat & |
|
|
(fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, & |
|
|
fid,ncvarid,ndim) |
|
|
|
|
|
iret = NF90_PUT_VAR (fid, ncvarid, var, & |
|
|
start=w_sta(1:ndim), count=w_len(1:ndim)) |
|
|
!------------------------- |
|
|
END SUBROUTINE flinput_r2d |
|
|
|
|
|
!=== |
|
|
|
|
|
SUBROUTINE flinput_r3d & |
|
|
(fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var) |
|
|
!--------------------------------------------------------------------- |
|
|
IMPLICIT NONE |
|
|
|
|
|
INTEGER :: fid_in |
|
|
CHARACTER(LEN=*) :: varname |
|
|
INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid |
|
|
REAL :: var(:,:,:) |
|
|
|
|
|
INTEGER :: fid, ncvarid, ndim, iret |
|
|
LOGICAL :: check = .FALSE. |
|
|
!--------------------------------------------------------------------- |
|
|
IF (check) WRITE(*,*) & |
|
|
"flinput_r3d : SIZE(var) = ",SIZE(var) |
|
|
|
|
|
CALL flinput_mat & |
|
|
(fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, & |
|
|
fid,ncvarid,ndim) |
|
|
|
|
|
iret = NF90_PUT_VAR (fid, ncvarid, var, & |
|
|
start=w_sta(1:ndim), count=w_len(1:ndim)) |
|
|
!------------------------- |
|
|
END SUBROUTINE flinput_r3d |
|
|
|
|
|
!=== |
|
|
|
|
|
SUBROUTINE flinput_r4d & |
|
|
(fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var) |
|
|
!--------------------------------------------------------------------- |
|
|
IMPLICIT NONE |
|
|
|
|
|
INTEGER :: fid_in |
|
|
CHARACTER(LEN=*) :: varname |
|
|
INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid |
|
|
REAL :: var(:,:,:,:) |
|
|
|
|
|
INTEGER :: fid, ncvarid, ndim, iret |
|
|
LOGICAL :: check = .FALSE. |
|
|
!--------------------------------------------------------------------- |
|
|
IF (check) WRITE(*,*) & |
|
|
"flinput_r4d : SIZE(var) = ",SIZE(var) |
|
|
|
|
|
CALL flinput_mat & |
|
|
(fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, & |
|
|
fid,ncvarid,ndim) |
|
|
|
|
|
iret = NF90_PUT_VAR (fid, ncvarid, var, & |
|
|
start=w_sta(1:ndim), count=w_len(1:ndim)) |
|
|
!------------------------- |
|
|
END SUBROUTINE flinput_r4d |
|
|
|
|
|
!=== |
|
|
|
|
|
SUBROUTINE flinput_mat & |
|
|
(fid_in,varname,iim,nlonid,jjm,nlatid, & |
|
|
llm,zdimid,ttm,tdimid,fid,ncvarid,ndim) |
|
|
!--------------------------------------------------------------------- |
|
|
IMPLICIT NONE |
|
|
|
|
|
INTEGER :: fid_in |
|
|
CHARACTER(LEN=*) :: varname |
|
|
INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid |
|
|
INTEGER :: fid, ncvarid, ndim |
|
|
|
|
|
! LOCAL |
|
|
|
|
|
INTEGER :: iret |
|
|
!--------------------------------------------------------------------- |
|
|
fid = ncids(fid_in) |
|
|
|
|
|
w_sta(1:4) = (/ 1, 1, 1, 1 /) |
|
|
w_len(1:2) = (/ iim, jjm /) |
|
|
w_dim(1:2) = (/ nlonid, nlatid /) |
|
|
|
|
|
IF ( (llm > 0).AND.(ttm > 0) ) THEN |
|
|
ndim = 4 |
|
|
w_len(3:4) = (/ llm, ttm /) |
|
|
w_dim(3:4) = (/ zdimid, tdimid /) |
|
|
ELSE IF (llm > 0) THEN |
|
|
ndim = 3 |
|
|
w_dim(3) = zdimid |
|
|
w_len(3) = llm |
|
|
ELSE IF (ttm > 0) THEN |
|
|
ndim = 3 |
|
|
w_dim(3) = tdimid |
|
|
w_len(3) = ttm |
|
|
ELSE |
|
|
ndim = 2 |
|
|
ENDIF |
|
|
|
|
|
iret = NF90_REDEF (fid) |
|
|
iret = NF90_DEF_VAR (fid,varname,NF90_FLOAT,w_dim(1:ndim),ncvarid) |
|
|
iret = NF90_PUT_ATT (fid,ncvarid,'short_name',TRIM(varname)) |
|
|
iret = NF90_ENDDEF (fid) |
|
|
!-------------------------- |
|
|
END SUBROUTINE flinput_mat |
|
|
|
|
|
!=== |
|
|
|
|
|
SUBROUTINE flinput_scal & |
|
|
(fid_in, varname, iim, nlonid, jjm, nlatid, & |
|
|
llm, zdimid, ttm, tdimid, var) |
|
|
!--------------------------------------------------------------------- |
|
|
IMPLICIT NONE |
|
|
|
|
|
INTEGER :: fid_in |
|
|
CHARACTER(LEN=*) :: varname |
|
|
INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid |
|
|
REAL :: var |
|
|
|
|
|
! LOCAL |
|
|
|
|
|
INTEGER :: fid, iret |
|
|
!--------------------------------------------------------------------- |
|
|
fid = ncids(fid_in) |
|
|
|
|
|
iret = NF90_REDEF (fid) |
|
|
iret = NF90_PUT_ATT (fid, NF90_GLOBAL, varname, REAL(var)) |
|
|
iret = NF90_ENDDEF (fid) |
|
|
!--------------------------- |
|
|
END SUBROUTINE flinput_scal |
|
|
|
|
|
!=== |
|
|
|
|
|
SUBROUTINE flinget_r1d & |
|
|
(fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var) |
|
|
!--------------------------------------------------------------------- |
|
|
IMPLICIT NONE |
|
|
|
|
|
INTEGER :: fid_in |
|
|
CHARACTER(LEN=*) :: varname |
|
|
INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin |
|
|
REAL :: var(:) |
|
|
|
|
|
INTEGER :: jl, ji |
|
|
REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp |
|
|
LOGICAL :: check = .FALSE. |
|
|
!--------------------------------------------------------------------- |
|
|
IF (.NOT.ALLOCATED(buff_tmp)) THEN |
|
|
IF (check) WRITE(*,*) & |
|
|
"flinget_r1d : allocate buff_tmp for buff_sz = ",SIZE(var) |
|
|
ALLOCATE (buff_tmp(SIZE(var))) |
|
|
ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN |
|
|
IF (check) WRITE(*,*) & |
|
|
"flinget_r1d : re-allocate buff_tmp for buff_sz = ",SIZE(var) |
|
|
DEALLOCATE (buff_tmp) |
|
|
ALLOCATE (buff_tmp(SIZE(var))) |
|
|
ENDIF |
|
|
|
|
|
CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, & |
|
|
itau_dep,itau_fin,1,iim,1,jjm,buff_tmp) |
|
|
|
|
|
jl=0 |
|
|
DO ji=1,SIZE(var,1) |
|
|
jl=jl+1 |
|
|
var(ji) = buff_tmp(jl) |
|
|
ENDDO |
|
|
!------------------------- |
|
|
END SUBROUTINE flinget_r1d |
|
|
|
|
|
!=== |
|
|
|
|
|
SUBROUTINE flinget_r2d & |
|
|
(fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var) |
|
|
!--------------------------------------------------------------------- |
|
|
IMPLICIT NONE |
|
|
|
|
|
INTEGER :: fid_in |
|
|
CHARACTER(LEN=*) :: varname |
|
|
INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin |
|
|
REAL :: var(:,:) |
|
|
|
|
|
INTEGER :: jl, jj, ji |
|
|
REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp |
|
|
LOGICAL :: check = .FALSE. |
|
|
!--------------------------------------------------------------------- |
|
|
IF (.NOT.ALLOCATED(buff_tmp)) THEN |
|
|
IF (check) WRITE(*,*) & |
|
|
"flinget_r2d : allocate buff_tmp for buff_sz = ",SIZE(var) |
|
|
ALLOCATE (buff_tmp(SIZE(var))) |
|
|
ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN |
|
|
IF (check) WRITE(*,*) & |
|
|
"flinget_r2d : re-allocate buff_tmp for buff_sz = ",SIZE(var) |
|
|
DEALLOCATE (buff_tmp) |
|
|
ALLOCATE (buff_tmp(SIZE(var))) |
|
|
ENDIF |
|
|
|
|
|
CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, & |
|
|
itau_dep,itau_fin,1,iim,1,jjm,buff_tmp) |
|
|
|
|
|
jl=0 |
|
|
DO jj=1,SIZE(var,2) |
|
|
DO ji=1,SIZE(var,1) |
|
|
jl=jl+1 |
|
|
var(ji,jj) = buff_tmp(jl) |
|
|
ENDDO |
|
|
ENDDO |
|
|
!------------------------- |
|
|
END SUBROUTINE flinget_r2d |
|
|
|
|
|
!=== |
|
|
|
|
|
SUBROUTINE flinget_r2d_zoom2d & |
|
|
(fid_in,varname,iim,jjm,llm,ttm, & |
|
|
itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,var) |
|
|
!--------------------------------------------------------------------- |
|
|
IMPLICIT NONE |
|
|
|
|
|
INTEGER :: fid_in |
|
|
CHARACTER(LEN=*) :: varname |
|
|
INTEGER :: iim,jjm,llm,ttm,itau_dep,itau_fin,iideb,jjdeb,iilen,jjlen |
|
|
REAL :: var(:,:) |
|
|
|
|
|
INTEGER :: jl, jj, ji |
|
|
REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp |
|
|
LOGICAL :: check = .FALSE. |
|
|
!--------------------------------------------------------------------- |
|
|
IF (.NOT.ALLOCATED(buff_tmp)) THEN |
|
|
IF (check) WRITE(*,*) & |
|
|
"flinget_r2d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var) |
|
|
ALLOCATE (buff_tmp(SIZE(var))) |
|
|
ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN |
|
|
IF (check) WRITE(*,*) & |
|
|
"flinget_r2d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var) |
|
|
DEALLOCATE (buff_tmp) |
|
|
ALLOCATE (buff_tmp(SIZE(var))) |
|
|
ENDIF |
|
|
|
|
|
CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, & |
|
|
itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,buff_tmp) |
|
|
|
|
|
jl=0 |
|
|
DO jj=1,SIZE(var,2) |
|
|
DO ji=1,SIZE(var,1) |
|
|
jl=jl+1 |
|
|
var(ji,jj) = buff_tmp(jl) |
|
|
ENDDO |
|
|
ENDDO |
|
|
!-------------------------------- |
|
|
END SUBROUTINE flinget_r2d_zoom2d |
|
|
|
|
|
!=== |
|
|
|
|
|
SUBROUTINE flinget_r3d(fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var) |
|
|
!--------------------------------------------------------------------- |
|
|
IMPLICIT NONE |
|
|
|
|
|
INTEGER, intent(in):: fid_in |
|
|
CHARACTER(LEN=*), intent(in):: varname |
|
|
INTEGER, intent(in):: iim, jjm, llm, ttm, itau_dep, itau_fin |
|
|
REAL, intent(out):: var(:,:,:) |
|
|
|
|
|
INTEGER :: jl, jk, jj, ji |
|
|
REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp |
|
|
LOGICAL :: check = .FALSE. |
|
|
!--------------------------------------------------------------------- |
|
|
IF (.NOT.ALLOCATED(buff_tmp)) THEN |
|
|
IF (check) WRITE(*,*) & |
|
|
"flinget_r3d : allocate buff_tmp for buff_sz = ",SIZE(var) |
|
|
ALLOCATE (buff_tmp(SIZE(var))) |
|
|
ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN |
|
|
IF (check) WRITE(*,*) & |
|
|
"flinget_r3d : re-allocate buff_tmp for buff_sz = ",SIZE(var) |
|
|
DEALLOCATE (buff_tmp) |
|
|
ALLOCATE (buff_tmp(SIZE(var))) |
|
|
ENDIF |
|
|
|
|
|
CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, & |
|
|
itau_dep,itau_fin,1,iim,1,jjm,buff_tmp) |
|
|
|
|
|
jl=0 |
|
|
DO jk=1,SIZE(var,3) |
|
|
DO jj=1,SIZE(var,2) |
|
|
DO ji=1,SIZE(var,1) |
|
|
jl=jl+1 |
|
|
var(ji,jj,jk) = buff_tmp(jl) |
|
|
ENDDO |
|
|
ENDDO |
|
|
ENDDO |
|
|
!------------------------- |
|
|
END SUBROUTINE flinget_r3d |
|
|
|
|
|
!=== |
|
|
|
|
|
SUBROUTINE flinget_r3d_zoom2d & |
|
|
(fid_in,varname,iim,jjm,llm,ttm, & |
|
|
itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,var) |
|
|
!--------------------------------------------------------------------- |
|
|
IMPLICIT NONE |
|
|
|
|
|
INTEGER :: fid_in |
|
|
CHARACTER(LEN=*) :: varname |
|
|
INTEGER :: iim,jjm,llm,ttm,itau_dep,itau_fin,iideb,jjdeb,iilen,jjlen |
|
|
REAL :: var(:,:,:) |
|
|
|
|
|
INTEGER :: jl, jk, jj, ji |
|
|
REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp |
|
|
LOGICAL :: check = .FALSE. |
|
|
!--------------------------------------------------------------------- |
|
|
IF (.NOT.ALLOCATED(buff_tmp)) THEN |
|
|
IF (check) WRITE(*,*) & |
|
|
"flinget_r3d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var) |
|
|
ALLOCATE (buff_tmp(SIZE(var))) |
|
|
ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN |
|
|
IF (check) WRITE(*,*) & |
|
|
"flinget_r3d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var) |
|
|
DEALLOCATE (buff_tmp) |
|
|
ALLOCATE (buff_tmp(SIZE(var))) |
|
|
ENDIF |
|
|
|
|
|
CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, & |
|
|
itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,buff_tmp) |
|
|
|
|
|
jl=0 |
|
|
DO jk=1,SIZE(var,3) |
|
|
DO jj=1,SIZE(var,2) |
|
|
DO ji=1,SIZE(var,1) |
|
|
jl=jl+1 |
|
|
var(ji,jj,jk) = buff_tmp(jl) |
|
|
ENDDO |
|
|
ENDDO |
|
|
ENDDO |
|
|
!-------------------------------- |
|
|
END SUBROUTINE flinget_r3d_zoom2d |
|
|
|
|
|
!=== |
|
|
|
|
|
SUBROUTINE flinget_r4d & |
|
|
(fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var) |
|
|
!--------------------------------------------------------------------- |
|
|
IMPLICIT NONE |
|
|
|
|
|
INTEGER :: fid_in |
|
|
CHARACTER(LEN=*) :: varname |
|
|
INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin |
|
|
REAL :: var(:,:,:,:) |
|
|
|
|
|
INTEGER :: jl, jk, jj, ji, jm |
|
|
REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp |
|
|
LOGICAL :: check = .FALSE. |
|
|
!--------------------------------------------------------------------- |
|
|
IF (.NOT.ALLOCATED(buff_tmp)) THEN |
|
|
IF (check) WRITE(*,*) & |
|
|
"flinget_r4d : allocate buff_tmp for buff_sz = ",SIZE(var) |
|
|
ALLOCATE (buff_tmp(SIZE(var))) |
|
|
ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN |
|
|
IF (check) WRITE(*,*) & |
|
|
"flinget_r4d : re-allocate buff_tmp for buff_sz = ",SIZE(var) |
|
|
DEALLOCATE (buff_tmp) |
|
|
ALLOCATE (buff_tmp(SIZE(var))) |
|
|
ENDIF |
|
|
|
|
|
CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, & |
|
|
itau_dep,itau_fin,1,iim,1,jjm,buff_tmp) |
|
|
|
|
|
jl=0 |
|
|
DO jm=1,SIZE(var,4) |
|
|
DO jk=1,SIZE(var,3) |
|
|
DO jj=1,SIZE(var,2) |
|
|
DO ji=1,SIZE(var,1) |
|
|
jl=jl+1 |
|
|
var(ji,jj,jk,jm) = buff_tmp(jl) |
|
|
ENDDO |
|
|
ENDDO |
|
|
ENDDO |
|
|
ENDDO |
|
|
!------------------------- |
|
|
END SUBROUTINE flinget_r4d |
|
|
|
|
|
!=== |
|
|
|
|
|
SUBROUTINE flinget_r4d_zoom2d & |
|
|
(fid_in,varname,iim,jjm,llm,ttm, & |
|
|
itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,var) |
|
|
!--------------------------------------------------------------------- |
|
|
IMPLICIT NONE |
|
|
|
|
|
INTEGER :: fid_in |
|
|
CHARACTER(LEN=*) :: varname |
|
|
INTEGER :: iim,jjm,llm,ttm,itau_dep,itau_fin,iideb,jjdeb,iilen,jjlen |
|
|
REAL :: var(:,:,:,:) |
|
|
|
|
|
INTEGER :: jl, jk, jj, ji, jm |
|
|
REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp |
|
|
LOGICAL :: check = .FALSE. |
|
|
!--------------------------------------------------------------------- |
|
|
IF (.NOT.ALLOCATED(buff_tmp)) THEN |
|
|
IF (check) WRITE(*,*) & |
|
|
"flinget_r4d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var) |
|
|
ALLOCATE (buff_tmp(SIZE(var))) |
|
|
ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN |
|
|
IF (check) WRITE(*,*) & |
|
|
"flinget_r4d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var) |
|
|
DEALLOCATE (buff_tmp) |
|
|
ALLOCATE (buff_tmp(SIZE(var))) |
|
|
ENDIF |
|
|
|
|
|
CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, & |
|
|
itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,buff_tmp) |
|
|
|
|
|
jl=0 |
|
|
DO jm=1,SIZE(var,4) |
|
|
DO jk=1,SIZE(var,3) |
|
|
DO jj=1,SIZE(var,2) |
|
|
DO ji=1,SIZE(var,1) |
|
|
jl=jl+1 |
|
|
var(ji,jj,jk,jm) = buff_tmp(jl) |
|
|
ENDDO |
|
|
ENDDO |
|
|
ENDDO |
|
|
ENDDO |
|
|
!-------------------------------- |
|
|
END SUBROUTINE flinget_r4d_zoom2d |
|
|
|
|
|
!=== |
|
|
|
|
|
SUBROUTINE flinget_mat & |
|
|
(fid_in, varname, iim, jjm, llm, ttm, itau_dep, & |
|
|
itau_fin, iideb, iilen, jjdeb, jjlen, var) |
|
|
!--------------------------------------------------------------------- |
|
|
!- This subroutine will read the variable named varname from |
|
|
!- the file previously opened by flinopen and identified by fid |
|
|
|
|
|
!- It is checked that the dimensions of the variable to be read |
|
|
!- correspond to what the user requested when he specified |
|
|
!- iim, jjm and llm. The only exception which is allowed is |
|
|
!- for compressed data where the horizontal grid is not expected |
|
|
!- to be iim x jjm. |
|
|
|
|
|
!- If variable is of size zero a global attribute is read. |
|
|
!- This global attribute will be of type real |
|
|
|
|
|
!- INPUT |
|
|
|
|
|
!- fid : File ID returned by flinopen |
|
|
!- varname : Name of the variable to be read from the file |
|
|
!- iim : | These three variables give the size of the variables |
|
|
!- jjm : | to be read. It will be verified that the variables |
|
|
!- llm : | fits in there. |
|
|
!- ttm : | |
|
|
!- itau_dep : Time step at which we will start to read |
|
|
!- itau_fin : Time step until which we are going to read |
|
|
!- For the moment this is done on indexes |
|
|
!- but it should be in the physical space. |
|
|
!- If there is no time-axis in the file then use a |
|
|
!- itau_fin < itau_dep, this will tell flinget not to |
|
|
!- expect a time-axis in the file. |
|
|
!- iideb : index i for zoom |
|
|
!- iilen : length of zoom |
|
|
!- jjdeb : index j for zoom |
|
|
!- jjlen : length of zoom |
|
|
|
|
|
!- OUTPUT |
|
|
|
|
|
!- var : array that will contain the data |
|
|
!--------------------------------------------------------------------- |
|
|
IMPLICIT NONE |
|
|
|
|
|
! ARGUMENTS |
|
|
|
|
|
INTEGER, intent(in):: fid_in |
|
|
CHARACTER(LEN=*), intent(in):: varname |
|
|
INTEGER, intent(in):: iim, jjm, llm, ttm, itau_dep, itau_fin |
|
|
INTEGER :: iideb |
|
|
integer, intent(in):: iilen |
|
|
integer jjdeb |
|
|
integer, intent(in):: jjlen |
|
|
REAL :: var(:) |
|
|
|
|
|
! LOCAL |
|
|
|
|
|
INTEGER :: iret, fid |
|
|
INTEGER :: vid, cvid, clen |
|
|
CHARACTER(LEN=70) :: str1 |
|
|
CHARACTER(LEN=250) :: att_n, tmp_n |
|
|
CHARACTER(LEN=5) :: axs_l |
|
|
INTEGER :: tmp_i |
|
|
REAL,SAVE :: mis_v=0. |
|
|
REAL :: tmp_r |
|
|
INTEGER :: ndims, x_typ, nb_atts |
|
|
INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: dimids |
|
|
INTEGER :: i, iv, nvars, i2d, cnd |
|
|
REAL,DIMENSION(:),ALLOCATABLE,SAVE :: var_tmp |
|
|
LOGICAL :: uncompress = .FALSE. |
|
|
LOGICAL :: check = .FALSE. |
|
|
!--------------------------------------------------------------------- |
|
|
fid = ncids(fid_in) |
|
|
|
|
|
IF (check) THEN |
|
|
WRITE(*,*) & |
|
|
'flinget_mat : fid_in, fid, varname :', fid_in, fid, TRIM(varname) |
|
|
WRITE(*,*) & |
|
|
'flinget_mat : iim, jjm, llm, ttm, itau_dep, itau_fin :', & |
|
|
iim, jjm, llm, ttm, itau_dep, itau_fin |
|
|
WRITE(*,*) & |
|
|
'flinget_mat : iideb, iilen, jjdeb, jjlen :', & |
|
|
iideb, iilen, jjdeb, jjlen |
|
|
ENDIF |
|
|
|
|
|
uncompress = .FALSE. |
|
|
|
|
|
! 1.0 We get first all the details on this variable from the file |
|
|
|
|
|
nvars = ncnbva(fid_in) |
|
|
|
|
|
vid = -1 |
|
|
iret = NF90_INQ_VARID (fid, varname, vid) |
|
|
|
|
|
IF (vid < 0 .OR. iret /= NF90_NOERR) THEN |
|
|
CALL histerr (3,'flinget', & |
|
|
'Variable '//TRIM(varname)//' not found in file',' ',' ') |
|
|
ENDIF |
|
|
|
|
|
iret = NF90_INQUIRE_VARIABLE (fid, vid, & |
|
|
ndims=ndims, dimids=dimids, nAtts=nb_atts) |
|
|
IF (check) THEN |
|
|
WRITE(*,*) & |
|
|
'flinget_mat : fid, vid :', fid, vid |
|
|
WRITE(*,*) & |
|
|
'flinget_mat : ndims, dimids(1:ndims), nb_atts :', & |
|
|
ndims, dimids(1:ndims), nb_atts |
|
|
ENDIF |
|
|
|
|
|
w_dim(:) = 0 |
|
|
DO i=1,ndims |
|
|
iret = NF90_INQUIRE_DIMENSION (fid, dimids(i), len=w_dim(i)) |
|
|
ENDDO |
|
|
IF (check) WRITE(*,*) & |
|
|
'flinget_mat : w_dim :', w_dim(1:ndims) |
|
|
|
|
|
mis_v = 0.0; axs_l = ' '; |
|
|
|
|
|
IF (nb_atts > 0) THEN |
|
|
IF (check) THEN |
|
|
WRITE(*,*) 'flinget_mat : attributes for variable :' |
|
|
ENDIF |
|
|
ENDIF |
|
|
DO i=1,nb_atts |
|
|
iret = NF90_INQ_ATTNAME (fid, vid, i, att_n) |
|
|
iret = NF90_INQUIRE_ATTRIBUTE (fid, vid, att_n, xtype=x_typ) |
|
|
CALL strlowercase (att_n) |
|
|
IF ( (x_typ == NF90_INT).OR.(x_typ == NF90_SHORT) & |
|
|
.OR.(x_typ == NF90_BYTE) ) THEN |
|
|
iret = NF90_GET_ATT (fid, vid, att_n, tmp_i) |
|
|
IF (check) THEN |
|
|
WRITE(*,*) ' ',TRIM(att_n),' : ',tmp_i |
|
|
ENDIF |
|
|
ELSE IF ( (x_typ == NF90_FLOAT).OR.(x_typ == NF90_DOUBLE) ) THEN |
|
|
iret = NF90_GET_ATT (fid, vid, att_n, tmp_r) |
|
|
IF (check) THEN |
|
|
WRITE(*,*) ' ',TRIM(att_n),' : ',tmp_r |
|
|
ENDIF |
|
|
IF (index(att_n,'missing_value') > 0) THEN |
|
|
mis_v = tmp_r |
|
|
ENDIF |
|
|
ELSE |
|
|
tmp_n = '' |
|
|
iret = NF90_GET_ATT (fid, vid, att_n, tmp_n) |
|
|
IF (check) THEN |
|
|
WRITE(*,*) ' ',TRIM(att_n),' : ',TRIM(tmp_n) |
|
|
ENDIF |
|
|
IF (index(att_n,'axis') > 0) THEN |
|
|
axs_l = tmp_n |
|
|
ENDIF |
|
|
ENDIF |
|
|
ENDDO |
|
|
!? |
|
|
!!!!!!!!!! We will need a verification on the type of the variable |
|
|
!? |
|
|
|
|
|
! 2.0 The dimensions are analysed to determine what is to be read |
|
|
|
|
|
! 2.1 the longitudes |
|
|
|
|
|
IF ( w_dim(1) /= iim .OR. w_dim(2) /= jjm) THEN |
|
|
!--- |
|
|
!-- There is a possibility that we have to deal with a compressed axis ! |
|
|
!--- |
|
|
iret = NF90_INQUIRE_DIMENSION (fid, dimids(1), & |
|
|
name=tmp_n, len=clen) |
|
|
iret = NF90_INQ_VARID (fid, tmp_n, cvid) |
|
|
!--- |
|
|
IF (check) WRITE(*,*) & |
|
|
'Dimname, iret , NF90_NOERR : ',TRIM(tmp_n),iret,NF90_NOERR |
|
|
!--- |
|
|
!-- If we have an axis which has the same name |
|
|
!-- as the dimension we can see if it is compressed |
|
|
!--- |
|
|
!-- TODO TODO for zoom2d |
|
|
!--- |
|
|
IF (iret == NF90_NOERR) THEN |
|
|
iret = NF90_GET_ATT (fid, cvid, 'compress', str1) |
|
|
!----- |
|
|
IF (iret == NF90_NOERR) THEN |
|
|
iret = NF90_INQUIRE_VARIABLE (fid,cvid,xtype=x_typ,ndims=cnd) |
|
|
!------- |
|
|
IF ( cnd /= 1 .AND. x_typ /= NF90_INT) THEN |
|
|
CALL histerr (3,'flinget', & |
|
|
'Variable '//TRIM(tmp_n)//' can not be a compressed axis', & |
|
|
'Either it has too many dimensions'// & |
|
|
' or it is not of type integer', ' ') |
|
|
ELSE |
|
|
!--------- |
|
|
!-------- Let us see if we already have that index table |
|
|
!--------- |
|
|
IF ( (cind_len /= clen).OR.(cind_vid /= cvid) & |
|
|
.OR.(cind_fid /= fid) ) THEN |
|
|
IF (ALLOCATED(cindex)) DEALLOCATE(cindex) |
|
|
ALLOCATE(cindex(clen)) |
|
|
cind_len = clen |
|
|
cind_vid = cvid |
|
|
cind_fid = fid |
|
|
iret = NF90_GET_VAR (fid, cvid, cindex) |
|
|
ENDIF |
|
|
!--------- |
|
|
!-------- In any case we need to set the slab of data to be read |
|
|
!--------- |
|
|
uncompress = .TRUE. |
|
|
w_sta(1) = 1 |
|
|
w_len(1) = clen |
|
|
i2d = 1 |
|
|
ENDIF |
|
|
ELSE |
|
|
str1 = 'The horizontal dimensions of '//varname |
|
|
CALL histerr (3,'flinget',str1, & |
|
|
'is not compressed and does not'// & |
|
|
' correspond to the requested size',' ') |
|
|
ENDIF |
|
|
ELSE |
|
|
IF (w_dim(1) /= iim) THEN |
|
|
str1 = 'The longitude dimension of '//varname |
|
|
CALL histerr (3,'flinget',str1, & |
|
|
'in the file is not equal to the dimension', & |
|
|
'that should be read') |
|
|
ENDIF |
|
|
IF (w_dim(2) /= jjm) THEN |
|
|
str1 = 'The latitude dimension of '//varname |
|
|
CALL histerr (3,'flinget',str1, & |
|
|
'in the file is not equal to the dimension', & |
|
|
'that should be read') |
|
|
ENDIF |
|
|
ENDIF |
|
|
ELSE |
|
|
w_sta(1:2) = (/ iideb, jjdeb /) |
|
|
w_len(1:2) = (/ iilen, jjlen /) |
|
|
i2d = 2 |
|
|
ENDIF |
|
|
|
|
|
! 2.3 Now the difficult part, the 3rd dimension which can be |
|
|
! time or levels. |
|
|
|
|
|
! Priority is given to the time axis if only three axes are present. |
|
|
|
|
|
IF (ndims > i2d) THEN |
|
|
!--- |
|
|
!-- 2.3.1 We have a vertical axis |
|
|
!--- |
|
|
IF (llm == 1 .AND. ndims == i2d+2 .OR. llm == w_dim(i2d+1)) THEN |
|
|
!----- |
|
|
IF (w_dim(i2d+1) /= llm) THEN |
|
|
CALL histerr (3,'flinget', & |
|
|
'The vertical dimension of '//varname, & |
|
|
'in the file is not equal to the dimension', & |
|
|
'that should be read') |
|
|
ELSE |
|
|
w_sta(i2d+1) = 1 |
|
|
IF (llm > 0) THEN |
|
|
w_len(i2d+1) = llm |
|
|
ELSE |
|
|
w_len(i2d+1) = w_sta(i2d+1) |
|
|
ENDIF |
|
|
ENDIF |
|
|
!----- |
|
|
IF ((itau_fin-itau_dep) >= 0) THEN |
|
|
IF (ndims /= i2d+2) THEN |
|
|
CALL histerr (3,'flinget', & |
|
|
'You attempt to read a time slab', & |
|
|
'but there is no time axis on this variable', varname) |
|
|
ELSE IF ((itau_fin - itau_dep) <= w_dim(i2d+2)) THEN |
|
|
w_sta(i2d+2) = itau_dep |
|
|
w_len(i2d+2) = itau_fin-itau_dep+1 |
|
|
ELSE |
|
|
CALL histerr (3,'flinget', & |
|
|
'The time step you try to read is not', & |
|
|
'in the file (1)', varname) |
|
|
ENDIF |
|
|
ELSE IF (ndims == i2d+2 .AND. w_dim(i2d+2) > 1) THEN |
|
|
CALL histerr (3,'flinget', & |
|
|
'There is a time axis in the file but no', & |
|
|
'time step give in the call', varname) |
|
|
ELSE |
|
|
w_sta(i2d+2) = 1 |
|
|
w_len(i2d+2) = 1 |
|
|
ENDIF |
|
|
ELSE |
|
|
!----- |
|
|
!---- 2.3.2 We do not have any vertical axis |
|
|
!----- |
|
|
IF (ndims == i2d+2) THEN |
|
|
CALL histerr (3,'flinget', & |
|
|
'The file contains 4 dimensions', & |
|
|
'but only 3 are requestes for variable ', varname) |
|
|
ENDIF |
|
|
IF ((itau_fin-itau_dep) >= 0) THEN |
|
|
IF (ndims == i2d+1) THEN |
|
|
IF ((itau_fin-itau_dep) < w_dim(i2d+1) ) THEN |
|
|
w_sta(i2d+1) = itau_dep |
|
|
w_len(i2d+1) = itau_fin-itau_dep+1 |
|
|
ELSE |
|
|
CALL histerr (3,'flinget', & |
|
|
'The time step you try to read is not', & |
|
|
'in the file (2)', varname) |
|
|
ENDIF |
|
|
ELSE |
|
|
CALL histerr (3,'flinget', & |
|
|
'From your input you sould have 3 dimensions', & |
|
|
'in the file but there are 4', varname) |
|
|
ENDIF |
|
|
ELSE |
|
|
IF (ndims == i2d+1 .AND. w_dim(i2d+1) > 1) THEN |
|
|
CALL histerr (3,'flinget', & |
|
|
'There is a time axis in the file but no', & |
|
|
'time step given in the call', varname) |
|
|
ELSE |
|
|
w_sta(i2d+1) = 1 |
|
|
w_len(i2d+1) = 1 |
|
|
ENDIF |
|
|
ENDIF |
|
|
ENDIF |
|
|
ELSE |
|
|
!--- |
|
|
!-- 2.3.3 We do not have any vertical axis |
|
|
!--- |
|
|
w_sta(i2d+1:i2d+2) = (/ 0, 0 /) |
|
|
w_len(i2d+1:i2d+2) = (/ 0, 0 /) |
|
|
ENDIF |
|
|
|
|
|
! 3.0 Reading the data |
|
|
|
|
|
IF (check) WRITE(*,*) & |
|
|
'flinget_mat 3.0 : ', uncompress, w_sta, w_len |
|
|
!--- |
|
|
IF (uncompress) THEN |
|
|
!--- |
|
|
IF (ALLOCATED(var_tmp)) THEN |
|
|
IF (SIZE(var_tmp) < clen) THEN |
|
|
DEALLOCATE(var_tmp) |
|
|
ALLOCATE(var_tmp(clen)) |
|
|
ENDIF |
|
|
ELSE |
|
|
ALLOCATE(var_tmp(clen)) |
|
|
ENDIF |
|
|
!--- |
|
|
iret = NF90_GET_VAR (fid, vid, var_tmp, & |
|
|
start=w_sta(:), count=w_len(:)) |
|
|
!--- |
|
|
var(:) = mis_v |
|
|
var(cindex(:)) = var_tmp(:) |
|
|
!--- |
|
|
ELSE |
|
|
iret = NF90_GET_VAR (fid, vid, var, & |
|
|
start=w_sta(:), count=w_len(:)) |
|
|
ENDIF |
|
|
|
|
|
IF (check) WRITE(*,*) 'flinget_mat 3.1 : ',NF90_STRERROR (iret) |
|
|
!-------------------------- |
|
|
END SUBROUTINE flinget_mat |
|
|
|
|
|
!=== |
|
|
|
|
|
SUBROUTINE flinget_scal & |
|
|
(fid_in, varname, iim, jjm, llm, ttm, itau_dep, itau_fin, var) |
|
|
!--------------------------------------------------------------------- |
|
|
!- This subroutine will read the variable named varname from |
|
|
!- the file previously opened by flinopen and identified by fid |
|
|
|
|
|
!- If variable is of size zero a global attribute is read. This |
|
|
!- global attribute will be of type real |
|
|
|
|
|
!- INPUT |
|
|
|
|
|
!- fid : File ID returned by flinopen |
|
|
!- varname : Name of the variable to be read from the file |
|
|
!- iim : | These three variables give the size of the variables |
|
|
!- jjm : | to be read. It will be verified that the variables |
|
|
!- llm : | fits in there. |
|
|
!- ttm : | |
|
|
!- itau_dep : Time step at which we will start to read |
|
|
!- itau_fin : Time step until which we are going to read |
|
|
!- For the moment this is done on indeces but it should be |
|
|
!- in the physical space |
|
|
!- If there is no time-axis in the file then use a |
|
|
!- itau_fin < itau_dep, this will tell flinget not to |
|
|
!- expect a time-axis in the file. |
|
|
|
|
|
!- OUTPUT |
|
|
|
|
|
!- var : scalar that will contain the data |
|
|
!--------------------------------------------------------------------- |
|
|
IMPLICIT NONE |
|
|
|
|
|
! ARGUMENTS |
|
|
|
|
|
INTEGER :: fid_in |
|
|
CHARACTER(LEN=*) :: varname |
|
|
INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin |
|
|
REAL :: var |
|
|
|
|
|
! LOCAL |
|
|
|
|
|
INTEGER :: iret, fid |
|
|
|
|
|
LOGICAL :: check = .FALSE. |
|
|
!--------------------------------------------------------------------- |
|
|
fid = ncids(fid_in) |
|
|
|
|
|
! 1.0 Reading a global attribute |
|
|
|
|
|
iret = NF90_GET_ATT (fid, NF90_GLOBAL, varname, var) |
|
|
!--------------------------- |
|
|
END SUBROUTINE flinget_scal |
|
|
|
|
|
!=== |
|
|
|
|
336 |
SUBROUTINE flinfindcood (fid_in, axtype, vid, ndim) |
SUBROUTINE flinfindcood (fid_in, axtype, vid, ndim) |
337 |
!--------------------------------------------------------------------- |
!--------------------------------------------------------------------- |
338 |
!- This subroutine explores the file in order to find |
!- This subroutine explores the file in order to find |
339 |
!- the coordinate according to a number of rules |
!- the coordinate according to a number of rules |
340 |
!--------------------------------------------------------------------- |
!--------------------------------------------------------------------- |
341 |
|
USE strlowercase_m, ONLY : strlowercase |
342 |
|
USE errioipsl, ONLY : histerr |
343 |
|
USE netcdf, ONLY : nf90_get_att, nf90_inquire_dimension, & |
344 |
|
nf90_inquire_variable, nf90_noerr |
345 |
|
|
346 |
IMPLICIT NONE |
IMPLICIT NONE |
347 |
|
|
348 |
! ARGUMENTS |
! ARGUMENTS |
491 |
|
|
492 |
SUBROUTINE flinclo (fid_in) |
SUBROUTINE flinclo (fid_in) |
493 |
!--------------------------------------------------------------------- |
!--------------------------------------------------------------------- |
494 |
|
USE netcdf, ONLY : nf90_close |
495 |
IMPLICIT NONE |
IMPLICIT NONE |
496 |
|
|
497 |
INTEGER :: fid_in |
INTEGER :: fid_in |
503 |
!--------------------- |
!--------------------- |
504 |
END SUBROUTINE flinclo |
END SUBROUTINE flinclo |
505 |
|
|
|
!=== |
|
|
|
|
|
SUBROUTINE flinquery_var(fid_in, varname, exists) |
|
|
!--------------------------------------------------------------------- |
|
|
!- Queries the existance of a variable in the file. |
|
|
!--------------------------------------------------------------------- |
|
|
IMPLICIT NONE |
|
|
|
|
|
INTEGER :: fid_in |
|
|
CHARACTER(LEN=*) varname |
|
|
LOGICAL :: exists |
|
|
|
|
|
INTEGER :: iret, fid, vid |
|
|
!--------------------------------------------------------------------- |
|
|
fid = ncids(fid_in) |
|
|
vid = -1 |
|
|
iret = NF90_INQ_VARID (fid, varname, vid) |
|
|
|
|
|
exists = ( (vid >= 0).AND.(iret == NF90_NOERR) ) |
|
|
!--------------------------- |
|
|
END SUBROUTINE flinquery_var |
|
|
|
|
|
!=== |
|
|
|
|
|
SUBROUTINE flininspect (fid_in) |
|
|
!--------------------------------------------------------------------- |
|
|
IMPLICIT NONE |
|
|
|
|
|
! fid : File id to inspect |
|
|
|
|
|
INTEGER :: fid_in |
|
|
|
|
|
!- LOCAL |
|
|
|
|
|
INTEGER :: iim, jjm, llm, ttm |
|
|
INTEGER :: iret, fid, ndims, nvars, nb_atts, id_unlim |
|
|
INTEGER :: iv, in, lll |
|
|
INTEGER :: xid, yid, zid, tid |
|
|
INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: idimid |
|
|
CHARACTER(LEN=80) :: name |
|
|
CHARACTER(LEN=30) :: axname |
|
|
!--------------------------------------------------------------------- |
|
|
fid = ncids(fid_in) |
|
|
|
|
|
iret = NF90_INQUIRE (fid, nDimensions=ndims, nVariables=nvars, & |
|
|
nAttributes=nb_atts, unlimitedDimId=id_unlim) |
|
|
|
|
|
WRITE (*,*) 'IOIPSL ID : ',fid_in |
|
|
WRITE (*,*) 'NetCDF ID : ',fid |
|
|
WRITE (*,*) 'Number of dimensions : ',ndims |
|
|
WRITE (*,*) 'Number of variables : ',nvars |
|
|
WRITE (*,*) 'Number of global attributes : ',nb_atts |
|
|
WRITE (*,*) 'ID unlimited : ',id_unlim |
|
|
|
|
|
xid = -1; iim = 0; |
|
|
yid = -1; jjm = 0; |
|
|
zid = -1; llm = 0; |
|
|
tid = -1; ttm = 0; |
|
|
|
|
|
DO iv=1,ndims |
|
|
!--- |
|
|
iret = NF90_INQUIRE_DIMENSION (fid, iv, name=axname, len=lll) |
|
|
CALL strlowercase (axname) |
|
|
axname = ADJUSTL(axname) |
|
|
!--- |
|
|
WRITE (*,*) 'Dimension number : ',iv |
|
|
WRITE (*,*) 'Dimension name : ',TRIM(axname) |
|
|
!--- |
|
|
IF ( (INDEX(axname,'x') == 1) & |
|
|
.OR.(INDEX(axname,'lon') == 1)) THEN |
|
|
xid = iv; iim = lll; |
|
|
WRITE (*,*) 'Dimension X size : ',iim |
|
|
ELSE IF ( (INDEX(axname,'y') == 1) & |
|
|
.OR.(INDEX(axname,'lat') == 1)) THEN |
|
|
yid = iv; jjm = lll; |
|
|
WRITE (*,*) 'Dimension Y size : ',jjm |
|
|
ELSE IF ( (INDEX(axname,'lev') == 1) & |
|
|
.OR.(INDEX(axname,'plev') == 1) & |
|
|
.OR.(INDEX(axname,'z') == 1) & |
|
|
.OR.(INDEX(axname,'depth') == 1)) THEN |
|
|
zid = iv; llm = lll; |
|
|
WRITE (*,*) 'Dimension Z size : ',llm |
|
|
ELSE IF ( (INDEX(axname,'tstep') == 1) & |
|
|
.OR.(INDEX(axname,'time_counter') == 1)) THEN |
|
|
!---- For the time we certainly need to allow for other names |
|
|
tid = iv; ttm = lll; |
|
|
ELSE IF (ndims == 1) THEN |
|
|
!---- Nothing was found and ndims=1 then we have a vector of data |
|
|
xid = 1; iim = lll; |
|
|
ENDIF |
|
|
!--- |
|
|
ENDDO |
|
|
|
|
|
! Keep all this information |
|
|
|
|
|
nbfiles = nbfiles+1 |
|
|
|
|
|
IF (nbfiles > nbfile_max) THEN |
|
|
CALL histerr(3,'flininspect', & |
|
|
'Too many files. Please increase nbfil_max', & |
|
|
'in program flincom.F90.',' ') |
|
|
ENDIF |
|
|
|
|
|
ncids(nbfiles) = fid |
|
|
ncnbd(nbfiles) = ndims |
|
|
|
|
|
ncdims(nbfiles,1:4) = (/ iim, jjm, llm, ttm /) |
|
|
|
|
|
ncfunli(nbfiles) = id_unlim |
|
|
ncnba(nbfiles) = nb_atts |
|
|
ncnbva(nbfiles) = nvars |
|
|
ncfileopen(nbfiles) = .TRUE. |
|
|
|
|
|
DO in=1,nvars |
|
|
iret = NF90_INQUIRE_VARIABLE (fid, in, & |
|
|
name=name, ndims=ndims, dimids=idimid, nAtts=nb_atts) |
|
|
WRITE (*,*) 'Variable number ------------ > ', in |
|
|
WRITE (*,*) 'Variable name : ', TRIM(name) |
|
|
WRITE (*,*) 'Number of dimensions : ', ndims |
|
|
WRITE (*,*) 'Dimensions ID''s : ', idimid(1:ndims) |
|
|
WRITE (*,*) 'Number of attributes : ', nb_atts |
|
|
ENDDO |
|
|
!------------------------- |
|
|
END SUBROUTINE flininspect |
|
|
|
|
|
!=== |
|
|
|
|
506 |
END MODULE flincom |
END MODULE flincom |