IOIPSL/Histcom/histhori_regular.f

module histhori_regular_m

  implicit none

contains

  SUBROUTINE histhori_regular(pfileid, pim, plon, pjm, plat, phname, phtitle, &
       phid)

    ! This subroutine is made to declare a new horizontale grid.
    ! It has to have the same number of points as
    ! the original Thus in this we routine we will only
    ! add two variable (longitude and latitude).
    ! Any variable in the file can thus point to this pair
    ! through an attribute. This routine is very usefull
    ! to allow staggered grids.

    ! INPUT

    ! pfileid: The id of the file to which the grid should be added
    ! pim: Size in the longitude direction
    ! plon: The longitudes
    ! pjm: Size in the latitude direction
    ! plat: The latitudes
    ! phname: The name of grid
    ! phtitle: The title of the grid

    ! OUTPUT

    ! phid: Id of the created grid

    ! We assume that the grid is rectilinear.

    USE errioipsl, ONLY: histerr
    USE histcom_var, ONLY: full_size, hax_name, nb_hax, ncdf_ids, slab_sz, &
         xid, yid
    USE netcdf, ONLY: nf90_float
    use netcdf95, only: nf95_redef, nf95_def_var, nf95_enddef, nf95_put_att, &
         nf95_put_var

    INTEGER, INTENT (IN):: pfileid, pim, pjm
    REAL, INTENT (IN), DIMENSION (pim, pjm):: plon, plat
    CHARACTER (len=*), INTENT (IN):: phname, phtitle
    INTEGER, INTENT (OUT):: phid

    CHARACTER (len=25):: lon_name, lat_name
    CHARACTER (len=80):: tmp_title, tmp_name
    INTEGER:: ndim
    INTEGER dims(2)
    INTEGER:: nlonid, nlatid
    INTEGER:: par_szx, par_szy
    INTEGER ncid

    !---------------------------------------------------------------------

    ! 1.0 Check that all fits in the buffers

    IF ((pim/=full_size(pfileid, 1)) .OR. (pjm/=full_size(pfileid, 2))) THEN
       CALL histerr(3, 'histhori', &
            'The new horizontal grid does not have the same size', &
            'as the one provided to histbeg. This is not yet ', &
            'possible in the hist package.')
    END IF

    ! 1.1 Create all the variables needed

    ncid = ncdf_ids(pfileid)

    ndim = 2
    dims(1:2) = (/ xid(pfileid), yid(pfileid) /)

    tmp_name = phname
    IF (nb_hax(pfileid)==0) THEN
       lon_name = 'lon'
       lat_name = 'lat'
    ELSE
       lon_name = 'lon_' // trim(tmp_name)
       lat_name = 'lat_' // trim(tmp_name)
    END IF

    ! 1.2 Save the informations

    phid = nb_hax(pfileid) + 1
    nb_hax(pfileid) = phid

    hax_name(pfileid, phid, 1:2) = (/ lon_name, lat_name/)
    tmp_title = phtitle

    ! 2.0 Longitude

    ndim = 1
    dims(1:1) = (/ xid(pfileid) /)

    call nf95_def_var(ncid, lon_name, nf90_float, dims(1:ndim), nlonid)
    call nf95_put_att(ncid, nlonid, 'units', 'degrees_east')
    call nf95_put_att(ncid, nlonid, 'valid_min', real(minval(plon)))
    call nf95_put_att(ncid, nlonid, 'valid_max', real(maxval(plon)))
    call nf95_put_att(ncid, nlonid, 'long_name', 'Longitude')
    call nf95_put_att(ncid, nlonid, 'nav_model', trim(tmp_title))

    ! 3.0 Latitude

    ndim = 1
    dims(1:1) = (/ yid(pfileid) /)

    call nf95_def_var(ncid, lat_name, nf90_float, dims(1:ndim), nlatid)
    call nf95_put_att(ncid, nlatid, 'units', 'degrees_north')
    call nf95_put_att(ncid, nlatid, 'valid_min', real(minval(plat)))
    call nf95_put_att(ncid, nlatid, 'valid_max', real(maxval(plat)))
    call nf95_put_att(ncid, nlatid, 'long_name', 'Latitude')
    call nf95_put_att(ncid, nlatid, 'nav_model', trim(tmp_title))

    call nf95_enddef(ncid)

    ! 4.0 storing the geographical coordinates

    par_szx = slab_sz(pfileid, 1)
    par_szy = slab_sz(pfileid, 2)

    ! Transfer the longitude

    call nf95_put_var(ncid, nlonid, plon(1:par_szx, 1))

    ! Transfer the latitude

    call nf95_put_var(ncid, nlatid, plat(1, 1:par_szy))

    call nf95_redef(ncid)

  END SUBROUTINE histhori_regular

end module histhori_regular_m
1	guez	61	module histhori_regular_m
2
3			implicit none
4
5			contains
6
7			SUBROUTINE histhori_regular(pfileid, pim, plon, pjm, plat, phname, phtitle, &
8			phid)
9
10			! This subroutine is made to declare a new horizontale grid.
11			! It has to have the same number of points as
12			! the original Thus in this we routine we will only
13			! add two variable (longitude and latitude).
14			! Any variable in the file can thus point to this pair
15			! through an attribute. This routine is very usefull
16			! to allow staggered grids.
17
18			! INPUT
19
20			! pfileid: The id of the file to which the grid should be added
21			! pim: Size in the longitude direction
22			! plon: The longitudes
23			! pjm: Size in the latitude direction
24			! plat: The latitudes
25			! phname: The name of grid
26			! phtitle: The title of the grid
27
28			! OUTPUT
29
30			! phid: Id of the created grid
31
32			! We assume that the grid is rectilinear.
33
34			USE errioipsl, ONLY: histerr
35	guez	178	USE histcom_var, ONLY: full_size, hax_name, nb_hax, ncdf_ids, slab_sz, &
36			xid, yid
37			USE netcdf, ONLY: nf90_float
38			use netcdf95, only: nf95_redef, nf95_def_var, nf95_enddef, nf95_put_att, &
39			nf95_put_var
40	guez	61
41			INTEGER, INTENT (IN):: pfileid, pim, pjm
42			REAL, INTENT (IN), DIMENSION (pim, pjm):: plon, plat
43			CHARACTER (len=*), INTENT (IN):: phname, phtitle
44			INTEGER, INTENT (OUT):: phid
45
46			CHARACTER (len=25):: lon_name, lat_name
47			CHARACTER (len=80):: tmp_title, tmp_name
48			INTEGER:: ndim
49	guez	178	INTEGER dims(2)
50	guez	61	INTEGER:: nlonid, nlatid
51	guez	178	INTEGER:: par_szx, par_szy
52			INTEGER ncid
53	guez	61
54			!---------------------------------------------------------------------
55
56			! 1.0 Check that all fits in the buffers
57
58			IF ((pim/=full_size(pfileid, 1)) .OR. (pjm/=full_size(pfileid, 2))) THEN
59			CALL histerr(3, 'histhori', &
60			'The new horizontal grid does not have the same size', &
61			'as the one provided to histbeg. This is not yet ', &
62			'possible in the hist package.')
63			END IF
64
65			! 1.1 Create all the variables needed
66
67			ncid = ncdf_ids(pfileid)
68
69			ndim = 2
70			dims(1:2) = (/ xid(pfileid), yid(pfileid) /)
71
72			tmp_name = phname
73			IF (nb_hax(pfileid)==0) THEN
74			lon_name = 'lon'
75			lat_name = 'lat'
76			ELSE
77			lon_name = 'lon_' // trim(tmp_name)
78			lat_name = 'lat_' // trim(tmp_name)
79			END IF
80
81			! 1.2 Save the informations
82
83			phid = nb_hax(pfileid) + 1
84			nb_hax(pfileid) = phid
85
86			hax_name(pfileid, phid, 1:2) = (/ lon_name, lat_name/)
87			tmp_title = phtitle
88
89			! 2.0 Longitude
90
91			ndim = 1
92			dims(1:1) = (/ xid(pfileid) /)
93
94	guez	178	call nf95_def_var(ncid, lon_name, nf90_float, dims(1:ndim), nlonid)
95			call nf95_put_att(ncid, nlonid, 'units', 'degrees_east')
96			call nf95_put_att(ncid, nlonid, 'valid_min', real(minval(plon)))
97			call nf95_put_att(ncid, nlonid, 'valid_max', real(maxval(plon)))
98			call nf95_put_att(ncid, nlonid, 'long_name', 'Longitude')
99			call nf95_put_att(ncid, nlonid, 'nav_model', trim(tmp_title))
100	guez	61
101			! 3.0 Latitude
102
103			ndim = 1
104			dims(1:1) = (/ yid(pfileid) /)
105
106	guez	178	call nf95_def_var(ncid, lat_name, nf90_float, dims(1:ndim), nlatid)
107			call nf95_put_att(ncid, nlatid, 'units', 'degrees_north')
108			call nf95_put_att(ncid, nlatid, 'valid_min', real(minval(plat)))
109			call nf95_put_att(ncid, nlatid, 'valid_max', real(maxval(plat)))
110			call nf95_put_att(ncid, nlatid, 'long_name', 'Latitude')
111			call nf95_put_att(ncid, nlatid, 'nav_model', trim(tmp_title))
112	guez	61
113	guez	178	call nf95_enddef(ncid)
114	guez	61
115			! 4.0 storing the geographical coordinates
116
117			par_szx = slab_sz(pfileid, 1)
118			par_szy = slab_sz(pfileid, 2)
119
120			! Transfer the longitude
121
122	guez	178	call nf95_put_var(ncid, nlonid, plon(1:par_szx, 1))
123	guez	61
124			! Transfer the latitude
125
126	guez	178	call nf95_put_var(ncid, nlatid, plat(1, 1:par_szy))
127	guez	61
128	guez	168	call nf95_redef(ncid)
129	guez	61
130			END SUBROUTINE histhori_regular
131
132			end module histhori_regular_m