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_ori, slab_sz, xid, yid
    USE netcdf, ONLY: nf90_def_var, nf90_enddef, nf90_float, &
         nf90_put_att, nf90_put_var
    use netcdf95, only: nf95_redef

    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, DIMENSION (2):: dims(2)
    INTEGER:: nlonid, nlatid
    INTEGER:: orix, oriy, par_szx, par_szy
    INTEGER:: iret, 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) /)

    iret = nf90_def_var(ncid, lon_name, nf90_float, dims(1:ndim), nlonid)
    iret = nf90_put_att(ncid, nlonid, 'units', 'degrees_east')
    iret = nf90_put_att(ncid, nlonid, 'valid_min', real(minval(plon)))
    iret = nf90_put_att(ncid, nlonid, 'valid_max', real(maxval(plon)))
    iret = nf90_put_att(ncid, nlonid, 'long_name', 'Longitude')
    iret = nf90_put_att(ncid, nlonid, 'nav_model', trim(tmp_title))

    ! 3.0 Latitude

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

    iret = nf90_def_var(ncid, lat_name, nf90_float, dims(1:ndim), nlatid)
    iret = nf90_put_att(ncid, nlatid, 'units', 'degrees_north')
    iret = nf90_put_att(ncid, nlatid, 'valid_min', real(minval(plat)))
    iret = nf90_put_att(ncid, nlatid, 'valid_max', real(maxval(plat)))
    iret = nf90_put_att(ncid, nlatid, 'long_name', 'Latitude')
    iret = nf90_put_att(ncid, nlatid, 'nav_model', trim(tmp_title))

    iret = nf90_enddef(ncid)

    ! 4.0 storing the geographical coordinates

    orix = slab_ori(pfileid, 1)
    oriy = slab_ori(pfileid, 2)
    par_szx = slab_sz(pfileid, 1)
    par_szy = slab_sz(pfileid, 2)

    ! Transfer the longitude

    iret = nf90_put_var(ncid, nlonid, plon(1:par_szx, 1))

    ! Transfer the latitude

    iret = nf90_put_var(ncid, nlatid, plat(1, 1:par_szy))

    call nf95_redef(ncid)

  END SUBROUTINE histhori_regular

end module histhori_regular_m
1	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	USE histcom_var, ONLY: full_size, hax_name, nb_hax, ncdf_ids, &
36	slab_ori, slab_sz, xid, yid
37	USE netcdf, ONLY: nf90_def_var, nf90_enddef, nf90_float, &
38	nf90_put_att, nf90_put_var
39	use netcdf95, only: nf95_redef
40
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	INTEGER, DIMENSION (2):: dims(2)
50	INTEGER:: nlonid, nlatid
51	INTEGER:: orix, oriy, par_szx, par_szy
52	INTEGER:: iret, ncid
53
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	iret = nf90_def_var(ncid, lon_name, nf90_float, dims(1:ndim), nlonid)
95	iret = nf90_put_att(ncid, nlonid, 'units', 'degrees_east')
96	iret = nf90_put_att(ncid, nlonid, 'valid_min', real(minval(plon)))
97	iret = nf90_put_att(ncid, nlonid, 'valid_max', real(maxval(plon)))
98	iret = nf90_put_att(ncid, nlonid, 'long_name', 'Longitude')
99	iret = nf90_put_att(ncid, nlonid, 'nav_model', trim(tmp_title))
100
101	! 3.0 Latitude
102
103	ndim = 1
104	dims(1:1) = (/ yid(pfileid) /)
105
106	iret = nf90_def_var(ncid, lat_name, nf90_float, dims(1:ndim), nlatid)
107	iret = nf90_put_att(ncid, nlatid, 'units', 'degrees_north')
108	iret = nf90_put_att(ncid, nlatid, 'valid_min', real(minval(plat)))
109	iret = nf90_put_att(ncid, nlatid, 'valid_max', real(maxval(plat)))
110	iret = nf90_put_att(ncid, nlatid, 'long_name', 'Latitude')
111	iret = nf90_put_att(ncid, nlatid, 'nav_model', trim(tmp_title))
112
113	iret = nf90_enddef(ncid)
114
115	! 4.0 storing the geographical coordinates
116
117	orix = slab_ori(pfileid, 1)
118	oriy = slab_ori(pfileid, 2)
119	par_szx = slab_sz(pfileid, 1)
120	par_szy = slab_sz(pfileid, 2)
121
122	! Transfer the longitude
123
124	iret = nf90_put_var(ncid, nlonid, plon(1:par_szx, 1))
125
126	! Transfer the latitude
127
128	iret = nf90_put_var(ncid, nlatid, plat(1, 1:par_szy))
129
130	call nf95_redef(ncid)
131
132	END SUBROUTINE histhori_regular
133
134	end module histhori_regular_m