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 netcdf, ONLY: nf90_def_dim, nf90_def_var, nf90_enddef, &
         nf90_float, nf90_put_att, nf90_put_var, nf90_redef
    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:: iret, 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)
    iret = nf90_def_dim(ncid, pzaxname(1:leng), pzsize, zaxid_tmp)
    iret = nf90_def_var(ncid, pzaxname(1:leng), nf90_float, zaxid_tmp, zdimid)

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

    iret = nf90_put_att(ncid, zdimid, 'valid_min', real(minval( &
         pzvalues(1:pzsize))))
    iret = nf90_put_att(ncid, zdimid, 'valid_max', real(maxval( &
         pzvalues(1:pzsize))))

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

    iret = nf90_enddef(ncid)

    iret = nf90_put_var(ncid, zdimid, pzvalues(1:pzsize))

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