IOIPSL/Histcom/histvert.f

module histvert_m

  implicit none

contains

  SUBROUTINE histvert(pfileid, pzaxname, pzaxtitle, pzaxunit, pzvalues, &
       pzaxid, pdirect)

    ! This subroutine defines a vertical axis and returns its id. It
    ! gives the user the possibility to define different vertical
    ! axes. For each variable defined with histdef a vertical axis can
    ! be specified by its ID.

    USE errioipsl, ONLY: histerr
    USE find_str_m, ONLY: find_str
    USE histcom_var, ONLY: nb_zax, nb_zax_max, ncdf_ids, zax_ids, &
         zax_name, zax_name_length, zax_size
    USE netcdf95, ONLY: nf95_def_dim, nf95_def_var, nf95_enddef, &
         nf95_put_att, nf95_put_var, nf95_redef
    use netcdf, only: nf90_float
    USE strlowercase_m, ONLY: strlowercase

    INTEGER, INTENT(IN):: pfileid 
    ! ID of the file the variable should be archived in

    CHARACTER(len=*), INTENT(IN):: pzaxname ! name of the vertical axis
    CHARACTER(len=*), INTENT(IN):: pzaxtitle ! title of the vertical axis
    CHARACTER(len=*), INTENT(IN):: pzaxunit ! units of the vertical axis

    REAL, INTENT(IN):: pzvalues(:) ! (pzsize) 
    ! coordinate values of the vertical axis

    INTEGER, INTENT(OUT):: pzaxid ! ID of the axis (not the netCDF ID)

    CHARACTER(len=*), INTENT(IN), OPTIONAL:: pdirect
    ! positive direction of the axis: up or down

    ! Local:
    INTEGER pzsize ! size of the vertical axis
    INTEGER:: pos, iv, nb, zdimid, zaxid_tmp
    CHARACTER(len=20):: str20, tab_str20(nb_zax_max)
    INTEGER:: tab_str20_length(nb_zax_max)
    CHARACTER(len=70):: str70, str71, str72
    CHARACTER(len=80):: str80
    CHARACTER(len=20):: direction
    INTEGER:: leng, ncid

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

    pzsize = size(pzvalues)

    ! 1.0 Verifications:
    ! Do we have enough space for an extra axis ?
    ! Is the name already in use ?

    ! - Direction of axis. Can we get if from the user.
    ! If not we put unknown.

    IF (present(pdirect)) THEN
       direction = trim(pdirect)
       CALL strlowercase(direction)
    ELSE
       direction = 'unknown'
    END IF

    ! Check the consistency of the attribute

    IF ((direction/='unknown') .AND. (direction/='up') .AND. &
         (direction/='down')) THEN
       direction = 'unknown'
       str80 = 'The specified axis was: ' // trim(direction)
       CALL histerr(2, 'histvert', &
            'The specified direction for the vertical axis is not possible.', &
            'it is replaced by: unknown', str80)
    END IF

    IF (nb_zax(pfileid)+1>nb_zax_max) THEN
       CALL histerr(3, 'histvert', &
            'Table of vertical axes too small. You should increase ', &
            'nb_zax_max in M_HISTCOM.f90 in order to accomodate all ', &
            'these variables ')
    END IF

    iv = nb_zax(pfileid)
    IF (iv>1) THEN
       str20 = pzaxname
       nb = iv - 1
       tab_str20(1:nb) = zax_name(pfileid, 1:nb)
       tab_str20_length(1:nb) = zax_name_length(pfileid, 1:nb)
       CALL find_str(nb, tab_str20, tab_str20_length, str20, pos)
    ELSE
       pos = 0
    END IF

    IF (pos>0) THEN
       str70 = 'Vertical axis already exists'
       WRITE(str71, '("Check variable ", a, " in file", I3)') str20, &
            pfileid
       str72 = 'Can also be a wrong file ID in another declaration'
       CALL histerr(3, 'histvert', str70, str71, str72)
    END IF

    iv = nb_zax(pfileid) + 1

    ! 2.0 Add the information to the file

    ncid = ncdf_ids(pfileid)

    leng = min(len_trim(pzaxname), 20)
    call nf95_def_dim(ncid, pzaxname(1:leng), pzsize, zaxid_tmp)
    call nf95_def_var(ncid, pzaxname(1:leng), nf90_float, zaxid_tmp, zdimid)

    leng = min(len_trim(pzaxunit), 20)
    call NF95_PUT_ATT(ncid, zdimid, 'units', pzaxunit(1:leng))
    call NF95_PUT_ATT(ncid, zdimid, 'positive', trim(direction))

    call NF95_PUT_ATT(ncid, zdimid, 'valid_min', real(minval( &
         pzvalues(1:pzsize))))
    call NF95_PUT_ATT(ncid, zdimid, 'valid_max', real(maxval( &
         pzvalues(1:pzsize))))

    leng = min(len_trim(pzaxname), 20)
    call NF95_PUT_ATT(ncid, zdimid, 'title', pzaxname(1:leng))
    leng = min(len_trim(pzaxtitle), 80)
    call NF95_PUT_ATT(ncid, zdimid, 'long_name', pzaxtitle(1:leng))

    call nf95_enddef(ncid)

    call nf95_put_var(ncid, zdimid, pzvalues(1:pzsize))

    call nf95_redef(ncid)

    ! 3.0 add the information to the common

    nb_zax(pfileid) = iv
    zax_size(pfileid, iv) = pzsize
    zax_name(pfileid, iv) = pzaxname
    zax_name_length(pfileid, iv) = len_trim(pzaxname)
    zax_ids(pfileid, iv) = zaxid_tmp
    pzaxid = iv

  END SUBROUTINE histvert

end module histvert_m
1	guez	61	module histvert_m
2
3			implicit none
4
5			contains
6
7	guez	67	SUBROUTINE histvert(pfileid, pzaxname, pzaxtitle, pzaxunit, pzvalues, &
8			pzaxid, pdirect)
9	guez	61
10	guez	67	! This subroutine defines a vertical axis and returns its id. It
11			! gives the user the possibility to define different vertical
12	guez	62	! axes. For each variable defined with histdef a vertical axis can
13			! be specified by its ID.
14	guez	61
15	guez	67	USE errioipsl, ONLY: histerr
16	guez	61	USE find_str_m, ONLY: find_str
17			USE histcom_var, ONLY: nb_zax, nb_zax_max, ncdf_ids, zax_ids, &
18			zax_name, zax_name_length, zax_size
19	guez	178	USE netcdf95, ONLY: nf95_def_dim, nf95_def_var, nf95_enddef, &
20			nf95_put_att, nf95_put_var, nf95_redef
21			use netcdf, only: nf90_float
22	guez	67	USE strlowercase_m, ONLY: strlowercase
23	guez	61
24	guez	62	INTEGER, INTENT(IN):: pfileid
25			! ID of the file the variable should be archived in
26	guez	61
27	guez	62	CHARACTER(len=*), INTENT(IN):: pzaxname ! name of the vertical axis
28	guez	67	CHARACTER(len=*), INTENT(IN):: pzaxtitle ! title of the vertical axis
29	guez	62	CHARACTER(len=*), INTENT(IN):: pzaxunit ! units of the vertical axis
30	guez	67
31			REAL, INTENT(IN):: pzvalues(:) ! (pzsize)
32			! coordinate values of the vertical axis
33
34	guez	62	INTEGER, INTENT(OUT):: pzaxid ! ID of the axis (not the netCDF ID)
35
36			CHARACTER(len=*), INTENT(IN), OPTIONAL:: pdirect
37			! positive direction of the axis: up or down
38
39			! Local:
40	guez	67	INTEGER pzsize ! size of the vertical axis
41	guez	61	INTEGER:: pos, iv, nb, zdimid, zaxid_tmp
42	guez	62	CHARACTER(len=20):: str20, tab_str20(nb_zax_max)
43	guez	61	INTEGER:: tab_str20_length(nb_zax_max)
44	guez	62	CHARACTER(len=70):: str70, str71, str72
45			CHARACTER(len=80):: str80
46			CHARACTER(len=20):: direction
47	guez	178	INTEGER:: leng, ncid
48	guez	61
49			!---------------------------------------------------------------------
50
51	guez	67	pzsize = size(pzvalues)
52
53	guez	61	! 1.0 Verifications:
54	guez	67	! Do we have enough space for an extra axis ?
55			! Is the name already in use ?
56	guez	61
57			! - Direction of axis. Can we get if from the user.
58	guez	67	! If not we put unknown.
59	guez	61
60			IF (present(pdirect)) THEN
61			direction = trim(pdirect)
62			CALL strlowercase(direction)
63			ELSE
64			direction = 'unknown'
65			END IF
66
67			! Check the consistency of the attribute
68
69			IF ((direction/='unknown') .AND. (direction/='up') .AND. &
70			(direction/='down')) THEN
71			direction = 'unknown'
72			str80 = 'The specified axis was: ' // trim(direction)
73			CALL histerr(2, 'histvert', &
74			'The specified direction for the vertical axis is not possible.', &
75			'it is replaced by: unknown', str80)
76			END IF
77
78			IF (nb_zax(pfileid)+1>nb_zax_max) THEN
79			CALL histerr(3, 'histvert', &
80			'Table of vertical axes too small. You should increase ', &
81			'nb_zax_max in M_HISTCOM.f90 in order to accomodate all ', &
82			'these variables ')
83			END IF
84
85			iv = nb_zax(pfileid)
86			IF (iv>1) THEN
87			str20 = pzaxname
88			nb = iv - 1
89			tab_str20(1:nb) = zax_name(pfileid, 1:nb)
90			tab_str20_length(1:nb) = zax_name_length(pfileid, 1:nb)
91			CALL find_str(nb, tab_str20, tab_str20_length, str20, pos)
92			ELSE
93			pos = 0
94			END IF
95
96			IF (pos>0) THEN
97			str70 = 'Vertical axis already exists'
98	guez	62	WRITE(str71, '("Check variable ", a, " in file", I3)') str20, &
99	guez	61	pfileid
100			str72 = 'Can also be a wrong file ID in another declaration'
101			CALL histerr(3, 'histvert', str70, str71, str72)
102			END IF
103
104			iv = nb_zax(pfileid) + 1
105
106			! 2.0 Add the information to the file
107
108			ncid = ncdf_ids(pfileid)
109
110			leng = min(len_trim(pzaxname), 20)
111	guez	178	call nf95_def_dim(ncid, pzaxname(1:leng), pzsize, zaxid_tmp)
112			call nf95_def_var(ncid, pzaxname(1:leng), nf90_float, zaxid_tmp, zdimid)
113	guez	61
114			leng = min(len_trim(pzaxunit), 20)
115	guez	178	call NF95_PUT_ATT(ncid, zdimid, 'units', pzaxunit(1:leng))
116			call NF95_PUT_ATT(ncid, zdimid, 'positive', trim(direction))
117	guez	61
118	guez	178	call NF95_PUT_ATT(ncid, zdimid, 'valid_min', real(minval( &
119	guez	61	pzvalues(1:pzsize))))
120	guez	178	call NF95_PUT_ATT(ncid, zdimid, 'valid_max', real(maxval( &
121	guez	61	pzvalues(1:pzsize))))
122
123			leng = min(len_trim(pzaxname), 20)
124	guez	178	call NF95_PUT_ATT(ncid, zdimid, 'title', pzaxname(1:leng))
125	guez	61	leng = min(len_trim(pzaxtitle), 80)
126	guez	178	call NF95_PUT_ATT(ncid, zdimid, 'long_name', pzaxtitle(1:leng))
127	guez	61
128	guez	178	call nf95_enddef(ncid)
129	guez	61
130	guez	178	call nf95_put_var(ncid, zdimid, pzvalues(1:pzsize))
131	guez	61
132	guez	178	call nf95_redef(ncid)
133	guez	61
134			! 3.0 add the information to the common
135
136			nb_zax(pfileid) = iv
137			zax_size(pfileid, iv) = pzsize
138			zax_name(pfileid, iv) = pzaxname
139			zax_name_length(pfileid, iv) = len_trim(pzaxname)
140			zax_ids(pfileid, iv) = zaxid_tmp
141			pzaxid = iv
142
143			END SUBROUTINE histvert
144
145			end module histvert_m