329 lines
9.5 KiB
Fortran
Executable File
329 lines
9.5 KiB
Fortran
Executable File
PROGRAM ncregular
|
|
!
|
|
!$Id: ncregular.f90 2281 2010-10-15 14:21:13Z smasson $
|
|
!-
|
|
! This software is governed by the CeCILL license
|
|
! See IOIPSL/IOIPSL_License_CeCILL.txt
|
|
!---------------------------------------------------------------------
|
|
!- This code replaces a 2D surface grid by vectors.
|
|
!- Obviously it only works if you have a regular grid.
|
|
!-
|
|
!- Jan Polcher (polcher@lmd.jussieu.fr)
|
|
!- Jacques Bellier (jacques.bellier@cea.fr)
|
|
!---------------------------------------------------------------------
|
|
USE netcdf
|
|
!-
|
|
IMPLICIT NONE
|
|
!-
|
|
INTEGER :: iread, if, in, iv, sz
|
|
INTEGER :: ier, nb_files, iret, ndims, nvars, nb_glat
|
|
INTEGER :: lon_dim_id, lat_dim_id
|
|
INTEGER :: lon_len, lat_len, lon_id, lat_id
|
|
INTEGER :: nav_lon_id, nav_lat_id
|
|
INTEGER :: alloc_stat_lon, alloc_stat_lat
|
|
!-
|
|
INTEGER,ALLOCATABLE :: file_id(:), tax_id(:)
|
|
CHARACTER(LEN=80),ALLOCATABLE :: names(:)
|
|
CHARACTER(LEN=80) :: dim_name
|
|
CHARACTER(LEN=80) :: varname
|
|
CHARACTER(LEN=20) :: xname, yname, lonname, latname
|
|
LOGICAL :: check, regular
|
|
!-
|
|
REAL,ALLOCATABLE :: lon(:), lat(:), lon2(:), lat2(:)
|
|
REAL,ALLOCATABLE :: del_lon(:), del_lat(:)
|
|
!-
|
|
INTEGER iargc, getarg
|
|
EXTERNAL iargc, getarg
|
|
!---------------------------------------------------------------------
|
|
alloc_stat_lon = 0
|
|
alloc_stat_lat = 0
|
|
!-
|
|
iread = iargc()
|
|
!-
|
|
ALLOCATE (names(iread),stat=ier)
|
|
IF (ier /= 0) THEN
|
|
WRITE (*,*) ' Could not allocate names of size ', iread
|
|
STOP 'nctax'
|
|
ENDIF
|
|
!-
|
|
CALL nct_getarg (iread, nb_files, names, check, &
|
|
& xname, yname, lonname, latname)
|
|
!-
|
|
! Allocate space
|
|
!-
|
|
ALLOCATE (file_id(nb_files),stat=ier)
|
|
IF (ier /= 0) THEN
|
|
WRITE (*,*) ' Could not allocate file_id of size ', nb_files
|
|
STOP 'nctax'
|
|
ENDIF
|
|
!-
|
|
ALLOCATE (tax_id(nb_files),stat=ier)
|
|
IF (ier /= 0) THEN
|
|
WRITE (*,*) ' Could not allocate tax_id of size ', nb_files
|
|
STOP 'nctax'
|
|
ENDIF
|
|
!-
|
|
DO if=1,nb_files
|
|
!---
|
|
IF (check) THEN
|
|
WRITE(*,*) 'ncregular : ', if, names(if)
|
|
ENDIF
|
|
!---
|
|
iret = NF90_OPEN (names(if),NF90_WRITE,file_id(if))
|
|
iret = NF90_INQUIRE (file_id(if),ndims,nvars,nb_glat,tax_id(if))
|
|
!---
|
|
!-- Get the IDs of the variables
|
|
!---
|
|
lon_len = -9999
|
|
lat_len = -9999
|
|
DO in=1,ndims
|
|
!-----
|
|
iret = NF90_INQUIRE_DIMENSION (file_id(if), in, dim_name, sz)
|
|
!-----
|
|
IF ( (LEN_TRIM(dim_name) == 1) &
|
|
& .AND.(INDEX(dim_name,TRIM(xname)) == 1) ) THEN
|
|
lon_dim_id = in
|
|
lon_len = sz
|
|
ENDIF
|
|
!-----
|
|
IF ( (LEN_TRIM(dim_name) == 1) &
|
|
& .AND.(INDEX(dim_name,TRIM(yname)) == 1) ) THEN
|
|
lat_dim_id = in
|
|
lat_len = sz
|
|
ENDIF
|
|
!-----
|
|
ENDDO
|
|
!---
|
|
IF ( (lon_len == -9999).OR.(lat_len == -9999) ) THEN
|
|
WRITE(*,*) 'ncregular : The specified dimensions were not'
|
|
WRITE(*,*) 'found in file : ',names(if)
|
|
iret = NF90_CLOSE (file_id(if))
|
|
STOP
|
|
ENDIF
|
|
!---
|
|
IF (check) THEN
|
|
WRITE(*,*) 'ncregular : lon_dim_id, lon_len',lon_dim_id,lon_len
|
|
WRITE(*,*) 'ncregular : lat_dim_id, lat_len',lat_dim_id,lat_len
|
|
ENDIF
|
|
!---
|
|
!-- Look for the right variables
|
|
!---
|
|
nav_lon_id = -9999
|
|
nav_lat_id = -9999
|
|
DO iv=1,nvars
|
|
iret = NF90_INQUIRE_VARIABLE (file_id(if),iv,name=varname)
|
|
IF (INDEX(varname,TRIM(lonname)) > 0) THEN
|
|
nav_lon_id = iv
|
|
ENDIF
|
|
IF (INDEX(varname,TRIM(latname)) > 0) THEN
|
|
nav_lat_id = iv
|
|
ENDIF
|
|
ENDDO
|
|
!---
|
|
IF ( (nav_lon_id == -9999).OR.(nav_lat_id == -9999) ) THEN
|
|
WRITE(*,*) 'ncregular : The specified coordinate fields'
|
|
WRITE(*,*) 'were not found in file : ',names(if)
|
|
iret = NF90_CLOSE (file_id(if))
|
|
STOP
|
|
ENDIF
|
|
!---
|
|
IF (check) THEN
|
|
WRITE(*,*) 'ncregular : nav_lon_id :', nav_lon_id
|
|
WRITE(*,*) 'ncregular : nav_lat_id :', nav_lat_id
|
|
ENDIF
|
|
!---
|
|
!-- Read variables from file and check if regular
|
|
!---
|
|
!-- Do we have the variable to read the
|
|
!---
|
|
IF ( alloc_stat_lon < lon_len) THEN
|
|
IF ( alloc_stat_lon > 0) THEN
|
|
deallocate(lon)
|
|
deallocate(lon2)
|
|
deallocate(del_lon)
|
|
ENDIF
|
|
allocate(lon(lon_len))
|
|
allocate(lon2(lon_len))
|
|
allocate(del_lon(lon_len))
|
|
alloc_stat_lon = lon_len
|
|
ENDIF
|
|
!---
|
|
IF ( alloc_stat_lat < lat_len) THEN
|
|
IF ( alloc_stat_lat > 0) THEN
|
|
deallocate(lat)
|
|
deallocate(lat2)
|
|
deallocate(del_lat)
|
|
ENDIF
|
|
allocate(lat(lat_len))
|
|
allocate(lat2(lat_len))
|
|
allocate(del_lat(lat_len))
|
|
alloc_stat_lat = lat_len
|
|
ENDIF
|
|
!---
|
|
!-- Read data
|
|
!---
|
|
iret = NF90_GET_VAR (file_id(if),nav_lon_id,lon, &
|
|
& start=(/1,1/),count=(/lon_len,1/),stride=(/1,1/))
|
|
iret = NF90_GET_VAR (file_id(if),nav_lon_id,lon2, &
|
|
& start=(/1,int(lat_len/2)/),count=(/lon_len,1/),stride=(/1,1/))
|
|
del_lon = lon-lon2
|
|
!-
|
|
iret = NF90_GET_VAR (file_id(if),nav_lat_id,lat, &
|
|
& start=(/1,1/),count=(/1,lat_len/),stride=(/lon_len,1/))
|
|
iret = NF90_GET_VAR (file_id(if),nav_lat_id,lat2, &
|
|
& start=(/int(lon_len/2),1/),count=(/1,lat_len/),stride=(/lon_len,1/))
|
|
del_lat = lat-lat2
|
|
!-
|
|
regular = ( (MAXVAL(del_lon) < 0.001) &
|
|
& .OR.(MAXVAL(del_lat) < 0.001) )
|
|
!---
|
|
!-- Create the new variables
|
|
!---
|
|
IF (regular) THEN
|
|
IF (check) THEN
|
|
WRITE(*,*) 'Regular case'
|
|
ENDIF
|
|
iret = NF90_REDEF (file_id(if))
|
|
iret = NF90_RENAME_DIM (file_id(if), lon_dim_id, 'lon')
|
|
iret = NF90_RENAME_DIM (file_id(if), lat_dim_id, 'lat')
|
|
IF (check) THEN
|
|
WRITE(*,*) 'Dimensions renamed'
|
|
ENDIF
|
|
iret = NF90_DEF_VAR (file_id(if), 'lon', NF90_FLOAT, &
|
|
& lon_dim_id, lon_id)
|
|
iret = NF90_DEF_VAR (file_id(if), 'lat', NF90_FLOAT, &
|
|
& lat_dim_id, lat_id)
|
|
IF (check) THEN
|
|
WRITE(*,*) 'New variables defined'
|
|
ENDIF
|
|
!-----
|
|
!---- Copy attributes
|
|
!-----
|
|
iret = NF90_COPY_ATT (file_id(if),nav_lon_id,'units', &
|
|
& file_id(if),lon_id)
|
|
iret = NF90_COPY_ATT (file_id(if),nav_lon_id,'title', &
|
|
& file_id(if),lon_id)
|
|
iret = NF90_COPY_ATT (file_id(if),nav_lon_id,'valid_max', &
|
|
& file_id(if),lon_id)
|
|
iret = NF90_COPY_ATT (file_id(if),nav_lon_id,'valid_min', &
|
|
& file_id(if),lon_id)
|
|
!-----
|
|
iret = NF90_COPY_ATT (file_id(if),nav_lat_id,'units', &
|
|
& file_id(if),lat_id)
|
|
iret = NF90_COPY_ATT (file_id(if),nav_lat_id,'title', &
|
|
& file_id(if),lat_id)
|
|
iret = NF90_COPY_ATT (file_id(if),nav_lat_id,'valid_max', &
|
|
& file_id(if),lat_id)
|
|
iret = NF90_COPY_ATT (file_id(if),nav_lat_id,'valid_min', &
|
|
& file_id(if),lat_id)
|
|
!-----
|
|
!---- Go into write mode
|
|
!-----
|
|
iret = NF90_ENDDEF (file_id(if))
|
|
!-----
|
|
!---- Write data
|
|
!-----
|
|
iret = NF90_PUT_VAR (file_id(if),lon_id,lon(1:lon_len))
|
|
iret = NF90_PUT_VAR (file_id(if),lat_id,lat(1:lat_len))
|
|
!-
|
|
iret = NF90_CLOSE (file_id(if))
|
|
ELSE
|
|
WRITE(*,*) 'ncregular : Your grid is not regular'
|
|
WRITE(*,*) names(if), 'remains unchanged'
|
|
iret = NF90_CLOSE (file_id(if))
|
|
ENDIF
|
|
!-
|
|
ENDDO
|
|
!--------------------
|
|
END PROGRAM ncregular
|
|
!-
|
|
!===
|
|
!-
|
|
SUBROUTINE nct_getarg (argx, nb_files, names, check, &
|
|
& xname, yname, lonname, latname)
|
|
!---------------------------------------------------------------------
|
|
!- Read the arguments of nctax.
|
|
!---------------------------------------------------------------------
|
|
INTEGER,INTENT(in) :: argx
|
|
INTEGER, INTENT(out) :: nb_files
|
|
CHARACTER(LEN=80),INTENT(out) :: names(argx)
|
|
CHARACTER(LEN=20) :: xname, yname, lonname, latname
|
|
!-
|
|
CHARACTER(LEN=80) :: tmp, tmp_arg
|
|
LOGICAL :: check
|
|
!---------------------------------------------------------------------
|
|
check = .FALSE.
|
|
!-
|
|
! Get the number of arguments
|
|
!-
|
|
nb_files = 0
|
|
!-
|
|
xname = 'x'
|
|
yname = 'y'
|
|
lonname = 'nav_lon'
|
|
latname = 'nav_lat'
|
|
!-
|
|
! Go through the arguments and analyse them one by one
|
|
!-
|
|
IF (check) WRITE(*,*) 'Start going through the arguments'
|
|
!-
|
|
IF (argx == 0) THEN
|
|
WRITE(*,*) 'To get usage : nctax -h '
|
|
STOP
|
|
ENDIF
|
|
!-
|
|
iread = 1
|
|
DO WHILE (iread <= argx)
|
|
iret = getarg(iread,tmp)
|
|
IF (check) WRITE(*,*) ' iread, tmp :', iread, tmp
|
|
SELECTCASE(tmp)
|
|
CASE('-d')
|
|
WRITE(*,*) 'DEBUG MODE SELECTED'
|
|
check = .TRUE.
|
|
iread = iread+1
|
|
CASE('-h')
|
|
WRITE(*,*) 'Usage : nregular [options] file1 [file2 ...]'
|
|
WRITE(*,*) ' -d : Verbose mode'
|
|
WRITE(*,*) ' -h : This output'
|
|
STOP
|
|
CASE('-dim_lon')
|
|
iread = iread+1
|
|
iret = getarg(iread,tmp_arg)
|
|
xname = TRIM(tmp_arg)
|
|
iread = iread+1
|
|
CASE('-dim_lat')
|
|
iread = iread+1
|
|
iret = getarg(iread,tmp_arg)
|
|
yname = TRIM(tmp_arg)
|
|
iread = iread+1
|
|
CASE('-coo_lon')
|
|
iread = iread+1
|
|
iret = getarg(iread,tmp_arg)
|
|
lonname = TRIM(tmp_arg)
|
|
iread = iread+1
|
|
CASE('-coo_lat')
|
|
iread = iread+1
|
|
iret = getarg(iread,tmp_arg)
|
|
latname = TRIM(tmp_arg)
|
|
iread = iread+1
|
|
CASE DEFAULT
|
|
IF (check) WRITE(*,*) 'nct_getarg : CASE default'
|
|
IF (INDEX(tmp,'-') /= 1) THEN
|
|
nb_files = nb_files+1
|
|
names(nb_files) = tmp
|
|
iread = iread+1
|
|
ELSE
|
|
WRITE(*,*) "WARNING Unknown option ",tmp
|
|
WRITE(*,*) "For ore information : nctax -h"
|
|
ENDIF
|
|
END SELECT
|
|
ENDDO
|
|
!-
|
|
IF (check) THEN
|
|
WRITE(*,*) ' nct_getarg : output >> '
|
|
WRITE(*,*) '>> nb_files : ', nb_files
|
|
WRITE(*,*) '>> names :', (names(ii), ii=1,nb_files)
|
|
ENDIF
|
|
!------------------------
|
|
END SUBROUTINE nct_getarg
|