IOIPSL/Histcom/histdef.f90

module histdef_m

  USE histcom_var, ONLY: nb_files_max, nb_var_max

  implicit none

  INTEGER:: buff_pos = 0
  INTEGER, SAVE:: point(nb_files_max, nb_var_max)
  private nb_files_max, nb_var_max

contains

  SUBROUTINE histdef(fileid, varname, ptitle, unit, xsize, ysize, &
       horiid, pzsize, oriz, szz, zid, opp, pfreq_opp, pfreq_wrt)

    ! With this subroutine each variable to be archived on the history
    ! tape should be declared. It gives the user the choice of
    ! operation to be performed on the variable, the frequency of
    ! this operation and the frequency of the archiving.

    USE buildop_m, ONLY: buildop
    USE errioipsl, ONLY: histerr
    USE find_str_m, ONLY: find_str
    use histbeg_totreg_m, only: deltat
    USE histcom_var, ONLY: freq_opp, freq_wrt, fullop, full_size, itau0, &
         last_opp, last_opp_chk, last_wrt, last_wrt_chk, missing_val, name, &
         name_length, nbopp, nbopp_max, nb_hax, nb_opp, nb_tax, nb_var, &
         nb_wrt, nb_zax, scal, scsize, slab_ori, slab_sz, sopps, &
         tax_last, tax_name, tax_name_length, title, topp, unit_name, &
         var_axid, var_haxid, var_zaxid, zax_name, zax_size, zorig, zsize
    USE ioget_calendar_m, ONLY: ioget_calendar_real

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

    CHARACTER(len=*), INTENT(IN):: varname
    ! (name of the variable, short and easy to remember)

    CHARACTER(len=*), INTENT(IN):: ptitle ! full name of the variable
    CHARACTER(len=*), INTENT(IN):: unit ! units of the variable

    ! The next 3 arguments give the size of that data
    ! that will be passed to histwrite. The zoom will be
    ! done there with the horizontal information obtained
    ! in "histbeg" and the vertical information to follow.
    INTEGER, INTENT(IN):: xsize, ysize ! Sizes in X and Y directions
    INTEGER, INTENT(IN):: horiid ! ID of the horizontal axis

    ! The next two arguments give the vertical zoom to use.

    INTEGER, INTENT(IN):: pzsize
    ! (Size in Z direction (If 1 then no axis is declared for this
    ! variable and zid is not used)

    INTEGER, INTENT(IN):: oriz ! Off set of the zoom
    INTEGER, INTENT(IN):: szz ! Size of the zoom

    INTEGER, INTENT(IN):: zid
    ! (ID of the vertical axis to use. It has to have the size of the zoom.)

    CHARACTER(len=*), INTENT(IN):: opp
    ! Operation to be performed. The following options exist today:
    ! inst: keeps instantaneous values for writting
    ! ave: Computes the average from call between writes

    REAL, INTENT(IN):: pfreq_opp ! Frequency of this operation (in seconds)

    REAL, INTENT(IN):: pfreq_wrt
    ! (Frequency at which the variable should be written, in seconds)

    ! Local:

    INTEGER:: iv, i, nb
    CHARACTER(len=70):: str70, str71, str72
    CHARACTER(len=20):: tmp_name
    CHARACTER(len=20):: str20, tab_str20(nb_var_max)
    INTEGER:: tab_str20_length(nb_var_max)
    CHARACTER(len=40):: str40, tab_str40(nb_var_max)
    INTEGER:: tab_str40_length(nb_var_max)
    CHARACTER(len=10):: str10
    CHARACTER(len=80):: tmp_str80
    CHARACTER(len=7):: tmp_topp, tmp_sopp(nbopp_max)
    CHARACTER(len=120):: ex_topps
    REAL:: tmp_scal(nbopp_max), un_an, un_jour, test_fopp, test_fwrt
    INTEGER:: pos, buff_sz

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

    ex_topps = 'ave, inst, t_min, t_max, t_sum, once, never, l_max, l_min'

    nb_var(fileid) = nb_var(fileid) + 1
    iv = nb_var(fileid)

    IF (iv>nb_var_max) THEN
       CALL histerr(3, 'histdef', &
            'Table of variables too small. You should increase nb_var_max', &
            'in M_HISTCOM.f90 in order to accomodate all these variables', ' ')
    END IF

    ! 1.0 Transfer informations on the variable to the common
    !     and verify that it does not already exist

    IF (iv>1) THEN
       str20 = varname
       nb = iv - 1
       tab_str20(1:nb) = name(fileid, 1:nb)
       tab_str20_length(1:nb) = name_length(fileid, 1:nb)
       CALL find_str(nb, tab_str20, tab_str20_length, str20, pos)
    ELSE
       pos = 0
    END IF

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

    name(fileid, iv) = varname
    name_length(fileid, iv) = len_trim(name(fileid, iv))
    title(fileid, iv) = ptitle
    unit_name(fileid, iv) = unit
    tmp_name = name(fileid, iv)

    ! 1.1 decode the operations

    fullop(fileid, iv) = opp
    tmp_str80 = opp
    CALL buildop(tmp_str80, ex_topps, tmp_topp, nbopp_max, missing_val, &
         tmp_sopp, tmp_scal, nbopp(fileid, iv))

    topp(fileid, iv) = tmp_topp
    DO i = 1, nbopp(fileid, iv)
       sopps(fileid, iv, i) = tmp_sopp(i)
       scal(fileid, iv, i) = tmp_scal(i)
    END DO

    ! 1.2 If we have an even number of operations
    !     then we need to add identity

    IF (2*int(nbopp(fileid, iv)/2.0)==nbopp(fileid, iv)) THEN
       nbopp(fileid, iv) = nbopp(fileid, iv) + 1
       sopps(fileid, iv, nbopp(fileid, iv)) = 'ident'
       scal(fileid, iv, nbopp(fileid, iv)) = missing_val
    END IF

    ! 2.0 Put the size of the variable in the common and check

    scsize(fileid, iv, :) = (/ xsize, ysize, pzsize/)

    zorig(fileid, iv, 1:3) = (/ slab_ori(fileid, 1), slab_ori(fileid, 2), &
         oriz/)

    zsize(fileid, iv, 1:3) = (/ slab_sz(fileid, 1), slab_sz(fileid, 2), &
         szz/)

    ! Is the size of the full array the same as that of the coordinates  ?

    IF ((xsize>full_size(fileid, 1)) .OR. (ysize>full_size(fileid, &
         2))) THEN

       str70 = 'The size of the variable is different ' // &
            'from the one of the coordinates'
       WRITE (str71, '("Size of coordinates:", 2I4)') full_size(fileid, 1), &
            full_size(fileid, 2)
       WRITE (str72, '("Size declared for variable ", a, ":", 2I4)') &
            trim(tmp_name), xsize, ysize
       CALL histerr(3, 'histdef', str70, str71, str72)
    END IF

    ! Is the size of the zoom smaler than the coordinates ?

    IF ((full_size(fileid, 1)<slab_sz(fileid, 1)) .OR. (full_size(fileid, &
         2)<slab_sz(fileid, 2))) THEN
       str70 = 'Size of variable should be greater or equal &
            &to those of the zoom'
       WRITE (str71, '("Size of XY zoom:", 2I4)') slab_sz(fileid, 1), &
            slab_sz(fileid, 1)
       WRITE (str72, '("Size declared for variable ", a, ":", 2I4)') &
            trim(tmp_name), xsize, ysize
       CALL histerr(3, 'histdef', str70, str71, str72)
    END IF

    ! 2.1 We store the horizontal grid information with minimal
    !     and a fall back onto the default grid

    IF (horiid>0 .AND. horiid<=nb_hax(fileid)) THEN
       var_haxid(fileid, iv) = horiid
    ELSE
       var_haxid(fileid, iv) = 1
       CALL histerr(2, 'histdef', &
            'We use the default grid for variable as an invalide', &
            'ID was provided for variable: ', varname)
    END IF

    ! 2.2 Check the vertical coordinates if needed

    IF (szz>1) THEN

       ! Does the vertical coordinate exist ?

       IF (zid>nb_zax(fileid)) THEN
          WRITE (str70, '("The vertical coordinate chosen for variable ", a)' &
               ) trim(tmp_name)
          str71 = ' Does not exist.'
          CALL histerr(3, 'histdef', str70, str71, ' ')
       END IF

       ! Is the vertical size of the variable equal to that of the axis ?

       IF (szz/=zax_size(fileid, zid)) THEN
          str20 = zax_name(fileid, zid)
          WRITE (str71, '("Size of zoom in z:", I4)') szz
          WRITE (str72, '("Size declared for axis ", a, ":", I4)') &
               trim(str20), zax_size(fileid, zid)
          CALL histerr(3, 'histdef', 'The size of the zoom does not ' &
               // 'correspond to the size of the chosen vertical axis', &
               str71, str72)
       END IF

       ! Is the zoom smaler that the total size of the variable ?

       IF (pzsize<szz) THEN
          str20 = zax_name(fileid, zid)
          str70 = 'The vertical size of variable ' // &
               'is smaller than that of the zoom.'
          WRITE (str71, '("Declared vertical size of data:", I5)') pzsize
          WRITE (str72, '("Size of zoom for variable ", a, " = ", I5)') &
               trim(tmp_name), szz
          CALL histerr(3, 'histdef', str70, str71, str72)
       END IF
       var_zaxid(fileid, iv) = zid
    ELSE
       var_zaxid(fileid, iv) = -99
    END IF

    ! 3.0 Determine the position of the variable in the buffer
    !     If it is instantaneous output then we do not use the buffer

    ! 3.1 We get the size of the arrays histwrite will get and check
    !     that they fit into the tmp_buffer

    buff_sz = zsize(fileid, iv, 1)*zsize(fileid, iv, 2)*zsize(fileid, iv, 3)

    ! 3.2 move the pointer of the buffer array for operation
    !     which need bufferisation

    IF ((trim(tmp_topp)/='inst') .AND. (trim(tmp_topp)/='once') .AND. ( &
         trim(tmp_topp)/='never')) THEN
       point(fileid, iv) = buff_pos + 1
       buff_pos = buff_pos + buff_sz
    END IF

    ! 4.0 Transfer the frequency of the operations and check
    !     for validity. We have to pay attention to negative values
    !     of the frequency which indicate monthly time-steps.
    !     The strategy is to bring it back to seconds for the tests

    freq_opp(fileid, iv) = pfreq_opp
    freq_wrt(fileid, iv) = pfreq_wrt

    CALL ioget_calendar_real(un_an, un_jour)
    IF (pfreq_opp<0) THEN
       CALL ioget_calendar_real(un_an)
       test_fopp = pfreq_opp*(-1.)*un_an/12.*un_jour
    ELSE
       test_fopp = pfreq_opp
    END IF
    IF (pfreq_wrt<0) THEN
       CALL ioget_calendar_real(un_an)
       test_fwrt = pfreq_wrt*(-1.)*un_an/12.*un_jour
    ELSE
       test_fwrt = pfreq_wrt
    END IF

    ! 4.1 Frequency of operations and output should be larger than deltat !

    IF (test_fopp<deltat(fileid)) THEN
       str70 = 'Frequency of operations should be larger than deltat'
       WRITE (str71, '("It is not the case for variable ", a, ":", F10.4)') &
            trim(tmp_name), pfreq_opp
       str72 = 'PATCH: frequency set to deltat'

       CALL histerr(2, 'histdef', str70, str71, str72)

       freq_opp(fileid, iv) = deltat(fileid)
    END IF

    IF (test_fwrt<deltat(fileid)) THEN
       str70 = 'Frequency of output should be larger than deltat'
       WRITE (str71, '("It is not the case for variable ", a, ":", F10.4)') &
            trim(tmp_name), pfreq_wrt
       str72 = 'PATCH: frequency set to deltat'

       CALL histerr(2, 'histdef', str70, str71, str72)

       freq_wrt(fileid, iv) = deltat(fileid)
    END IF

    ! 4.2 First the existence of the operation is tested and then
    !     its compatibility with the choice of frequencies

    IF (trim(tmp_topp)=='inst') THEN
       IF (test_fopp/=test_fwrt) THEN
          str70 = 'For instantaneous output the frequency ' // &
               'of operations and output'
          WRITE (str71, &
               '("should be the same, this was not case for variable ", a)') &
               trim(tmp_name)
          str72 = 'PATCH: The smalest frequency of both is used'
          CALL histerr(2, 'histdef', str70, str71, str72)
          IF (test_fopp<test_fwrt) THEN
             freq_opp(fileid, iv) = pfreq_opp
             freq_wrt(fileid, iv) = pfreq_opp
          ELSE
             freq_opp(fileid, iv) = pfreq_wrt
             freq_wrt(fileid, iv) = pfreq_wrt
          END IF
       END IF
    ELSE IF (index(ex_topps, trim(tmp_topp))>0) THEN
       IF (test_fopp>test_fwrt) THEN
          str70 = 'For averages the frequency of operations ' // &
               'should be smaller or equal'
          WRITE (str71, &
               '("to that of output. It is not the case for variable ", a)') &
               trim(tmp_name)
          str72 = 'PATCH: The output frequency is used for both'
          CALL histerr(2, 'histdef', str70, str71, str72)
          freq_opp(fileid, iv) = pfreq_wrt
       END IF
    ELSE
       WRITE (str70, '("Operation on variable ", a, " is unknown")') &
            trim(tmp_name)
       WRITE (str71, '("operation requested is:", a)') tmp_topp
       WRITE (str72, '("File ID:", I3)') fileid
       CALL histerr(3, 'histdef', str70, str71, str72)
    END IF

    ! 5.0 Initialize other variables of the common

    last_opp(fileid, iv) = itau0(fileid)
    ! - freq_opp(fileid, iv)/2./deltat(fileid)
    last_wrt(fileid, iv) = itau0(fileid)
    ! - freq_wrt(fileid, iv)/2./deltat(fileid)
    last_opp_chk(fileid, iv) = itau0(fileid)
    ! - freq_opp(fileid, iv)/2./deltat(fileid)
    last_wrt_chk(fileid, iv) = itau0(fileid)
    ! - freq_wrt(fileid, iv)/2./deltat(fileid)
    nb_opp(fileid, iv) = 0
    nb_wrt(fileid, iv) = 0

    ! 6.0 Get the time axis for this variable

    IF (freq_wrt(fileid, iv)>0) THEN
       WRITE (str10, '(I8.8)') int(freq_wrt(fileid, iv))
       str40 = trim(tmp_topp) // '_' // trim(str10)
    ELSE
       WRITE (str10, '(I2.2, "month")') abs(int(freq_wrt(fileid, iv)))
       str40 = trim(tmp_topp) // '_' // trim(str10)
    END IF

    DO i = 1, nb_tax(fileid)
       tab_str40(i) = tax_name(fileid, i)
       tab_str40_length(i) = tax_name_length(fileid, i)
    END DO

    CALL find_str(nb_tax(fileid), tab_str40, tab_str40_length, str40, pos)

    ! No time axis for once, l_max, l_min or never operation

    IF ((trim(tmp_topp)/='once') .AND. (trim(tmp_topp)/='never') .AND. ( &
         trim(tmp_topp)/='l_max') .AND. (trim(tmp_topp)/='l_min')) THEN
       IF (pos<0) THEN
          nb_tax(fileid) = nb_tax(fileid) + 1
          tax_name(fileid, nb_tax(fileid)) = str40
          tax_name_length(fileid, nb_tax(fileid)) = len_trim(str40)
          tax_last(fileid, nb_tax(fileid)) = 0
          var_axid(fileid, iv) = nb_tax(fileid)
       ELSE
          var_axid(fileid, iv) = pos
       END IF
    ELSE
       var_axid(fileid, iv) = -99
    END IF

    ! 7.0 prepare frequence of writing and operation
    !     for never or once operation

    IF ((trim(tmp_topp)=='once') .OR. (trim(tmp_topp)=='never')) THEN
       freq_opp(fileid, iv) = 0.
       freq_wrt(fileid, iv) = 0.
    END IF

  END SUBROUTINE histdef

end module histdef_m
1	module histdef_m
2
3	USE histcom_var, ONLY: nb_files_max, nb_var_max
4
5	implicit none
6
7	INTEGER:: buff_pos = 0
8	INTEGER, SAVE:: point(nb_files_max, nb_var_max)
9	private nb_files_max, nb_var_max
10
11	contains
12
13	SUBROUTINE histdef(fileid, varname, ptitle, unit, xsize, ysize, &
14	horiid, pzsize, oriz, szz, zid, opp, pfreq_opp, pfreq_wrt)
15
16	! With this subroutine each variable to be archived on the history
17	! tape should be declared. It gives the user the choice of
18	! operation to be performed on the variable, the frequency of
19	! this operation and the frequency of the archiving.
20
21	USE buildop_m, ONLY: buildop
22	USE errioipsl, ONLY: histerr
23	USE find_str_m, ONLY: find_str
24	use histbeg_totreg_m, only: deltat
25	USE histcom_var, ONLY: freq_opp, freq_wrt, fullop, full_size, itau0, &
26	last_opp, last_opp_chk, last_wrt, last_wrt_chk, missing_val, name, &
27	name_length, nbopp, nbopp_max, nb_hax, nb_opp, nb_tax, nb_var, &
28	nb_wrt, nb_zax, scal, scsize, slab_ori, slab_sz, sopps, &
29	tax_last, tax_name, tax_name_length, title, topp, unit_name, &
30	var_axid, var_haxid, var_zaxid, zax_name, zax_size, zorig, zsize
31	USE ioget_calendar_m, ONLY: ioget_calendar_real
32
33	INTEGER, INTENT(IN):: fileid
34	! (ID of the file the variable should be archived in)
35
36	CHARACTER(len=*), INTENT(IN):: varname
37	! (name of the variable, short and easy to remember)
38
39	CHARACTER(len=*), INTENT(IN):: ptitle ! full name of the variable
40	CHARACTER(len=*), INTENT(IN):: unit ! units of the variable
41
42	! The next 3 arguments give the size of that data
43	! that will be passed to histwrite. The zoom will be
44	! done there with the horizontal information obtained
45	! in "histbeg" and the vertical information to follow.
46	INTEGER, INTENT(IN):: xsize, ysize ! Sizes in X and Y directions
47	INTEGER, INTENT(IN):: horiid ! ID of the horizontal axis
48
49	! The next two arguments give the vertical zoom to use.
50
51	INTEGER, INTENT(IN):: pzsize
52	! (Size in Z direction (If 1 then no axis is declared for this
53	! variable and zid is not used)
54
55	INTEGER, INTENT(IN):: oriz ! Off set of the zoom
56	INTEGER, INTENT(IN):: szz ! Size of the zoom
57
58	INTEGER, INTENT(IN):: zid
59	! (ID of the vertical axis to use. It has to have the size of the zoom.)
60
61	CHARACTER(len=*), INTENT(IN):: opp
62	! Operation to be performed. The following options exist today:
63	! inst: keeps instantaneous values for writting
64	! ave: Computes the average from call between writes
65
66	REAL, INTENT(IN):: pfreq_opp ! Frequency of this operation (in seconds)
67
68	REAL, INTENT(IN):: pfreq_wrt
69	! (Frequency at which the variable should be written, in seconds)
70
71	! Local:
72
73	INTEGER:: iv, i, nb
74	CHARACTER(len=70):: str70, str71, str72
75	CHARACTER(len=20):: tmp_name
76	CHARACTER(len=20):: str20, tab_str20(nb_var_max)
77	INTEGER:: tab_str20_length(nb_var_max)
78	CHARACTER(len=40):: str40, tab_str40(nb_var_max)
79	INTEGER:: tab_str40_length(nb_var_max)
80	CHARACTER(len=10):: str10
81	CHARACTER(len=80):: tmp_str80
82	CHARACTER(len=7):: tmp_topp, tmp_sopp(nbopp_max)
83	CHARACTER(len=120):: ex_topps
84	REAL:: tmp_scal(nbopp_max), un_an, un_jour, test_fopp, test_fwrt
85	INTEGER:: pos, buff_sz
86
87	!---------------------------------------------------------------------
88
89	ex_topps = 'ave, inst, t_min, t_max, t_sum, once, never, l_max, l_min'
90
91	nb_var(fileid) = nb_var(fileid) + 1
92	iv = nb_var(fileid)
93
94	IF (iv>nb_var_max) THEN
95	CALL histerr(3, 'histdef', &
96	'Table of variables too small. You should increase nb_var_max', &
97	'in M_HISTCOM.f90 in order to accomodate all these variables', ' ')
98	END IF
99
100	! 1.0 Transfer informations on the variable to the common
101	! and verify that it does not already exist
102
103	IF (iv>1) THEN
104	str20 = varname
105	nb = iv - 1
106	tab_str20(1:nb) = name(fileid, 1:nb)
107	tab_str20_length(1:nb) = name_length(fileid, 1:nb)
108	CALL find_str(nb, tab_str20, tab_str20_length, str20, pos)
109	ELSE
110	pos = 0
111	END IF
112
113	IF (pos>0) THEN
114	str70 = 'Variable already exists'
115	WRITE (str71, '("Check variable ", a, " in file", I3)') str20, &
116	fileid
117	str72 = 'Can also be a wrong file ID in another declaration'
118	CALL histerr(3, 'histdef', str70, str71, str72)
119	END IF
120
121	name(fileid, iv) = varname
122	name_length(fileid, iv) = len_trim(name(fileid, iv))
123	title(fileid, iv) = ptitle
124	unit_name(fileid, iv) = unit
125	tmp_name = name(fileid, iv)
126
127	! 1.1 decode the operations
128
129	fullop(fileid, iv) = opp
130	tmp_str80 = opp
131	CALL buildop(tmp_str80, ex_topps, tmp_topp, nbopp_max, missing_val, &
132	tmp_sopp, tmp_scal, nbopp(fileid, iv))
133
134	topp(fileid, iv) = tmp_topp
135	DO i = 1, nbopp(fileid, iv)
136	sopps(fileid, iv, i) = tmp_sopp(i)
137	scal(fileid, iv, i) = tmp_scal(i)
138	END DO
139
140	! 1.2 If we have an even number of operations
141	! then we need to add identity
142
143	IF (2*int(nbopp(fileid, iv)/2.0)==nbopp(fileid, iv)) THEN
144	nbopp(fileid, iv) = nbopp(fileid, iv) + 1
145	sopps(fileid, iv, nbopp(fileid, iv)) = 'ident'
146	scal(fileid, iv, nbopp(fileid, iv)) = missing_val
147	END IF
148
149	! 2.0 Put the size of the variable in the common and check
150
151	scsize(fileid, iv, :) = (/ xsize, ysize, pzsize/)
152
153	zorig(fileid, iv, 1:3) = (/ slab_ori(fileid, 1), slab_ori(fileid, 2), &
154	oriz/)
155
156	zsize(fileid, iv, 1:3) = (/ slab_sz(fileid, 1), slab_sz(fileid, 2), &
157	szz/)
158
159	! Is the size of the full array the same as that of the coordinates ?
160
161	IF ((xsize>full_size(fileid, 1)) .OR. (ysize>full_size(fileid, &
162	2))) THEN
163
164	str70 = 'The size of the variable is different ' // &
165	'from the one of the coordinates'
166	WRITE (str71, '("Size of coordinates:", 2I4)') full_size(fileid, 1), &
167	full_size(fileid, 2)
168	WRITE (str72, '("Size declared for variable ", a, ":", 2I4)') &
169	trim(tmp_name), xsize, ysize
170	CALL histerr(3, 'histdef', str70, str71, str72)
171	END IF
172
173	! Is the size of the zoom smaler than the coordinates ?
174
175	IF ((full_size(fileid, 1)<slab_sz(fileid, 1)) .OR. (full_size(fileid, &
176	2)<slab_sz(fileid, 2))) THEN
177	str70 = 'Size of variable should be greater or equal &
178	&to those of the zoom'
179	WRITE (str71, '("Size of XY zoom:", 2I4)') slab_sz(fileid, 1), &
180	slab_sz(fileid, 1)
181	WRITE (str72, '("Size declared for variable ", a, ":", 2I4)') &
182	trim(tmp_name), xsize, ysize
183	CALL histerr(3, 'histdef', str70, str71, str72)
184	END IF
185
186	! 2.1 We store the horizontal grid information with minimal
187	! and a fall back onto the default grid
188
189	IF (horiid>0 .AND. horiid<=nb_hax(fileid)) THEN
190	var_haxid(fileid, iv) = horiid
191	ELSE
192	var_haxid(fileid, iv) = 1
193	CALL histerr(2, 'histdef', &
194	'We use the default grid for variable as an invalide', &
195	'ID was provided for variable: ', varname)
196	END IF
197
198	! 2.2 Check the vertical coordinates if needed
199
200	IF (szz>1) THEN
201
202	! Does the vertical coordinate exist ?
203
204	IF (zid>nb_zax(fileid)) THEN
205	WRITE (str70, '("The vertical coordinate chosen for variable ", a)' &
206	) trim(tmp_name)
207	str71 = ' Does not exist.'
208	CALL histerr(3, 'histdef', str70, str71, ' ')
209	END IF
210
211	! Is the vertical size of the variable equal to that of the axis ?
212
213	IF (szz/=zax_size(fileid, zid)) THEN
214	str20 = zax_name(fileid, zid)
215	WRITE (str71, '("Size of zoom in z:", I4)') szz
216	WRITE (str72, '("Size declared for axis ", a, ":", I4)') &
217	trim(str20), zax_size(fileid, zid)
218	CALL histerr(3, 'histdef', 'The size of the zoom does not ' &
219	// 'correspond to the size of the chosen vertical axis', &
220	str71, str72)
221	END IF
222
223	! Is the zoom smaler that the total size of the variable ?
224
225	IF (pzsize<szz) THEN
226	str20 = zax_name(fileid, zid)
227	str70 = 'The vertical size of variable ' // &
228	'is smaller than that of the zoom.'
229	WRITE (str71, '("Declared vertical size of data:", I5)') pzsize
230	WRITE (str72, '("Size of zoom for variable ", a, " = ", I5)') &
231	trim(tmp_name), szz
232	CALL histerr(3, 'histdef', str70, str71, str72)
233	END IF
234	var_zaxid(fileid, iv) = zid
235	ELSE
236	var_zaxid(fileid, iv) = -99
237	END IF
238
239	! 3.0 Determine the position of the variable in the buffer
240	! If it is instantaneous output then we do not use the buffer
241
242	! 3.1 We get the size of the arrays histwrite will get and check
243	! that they fit into the tmp_buffer
244
245	buff_sz = zsize(fileid, iv, 1)zsize(fileid, iv, 2)zsize(fileid, iv, 3)
246
247	! 3.2 move the pointer of the buffer array for operation
248	! which need bufferisation
249
250	IF ((trim(tmp_topp)/='inst') .AND. (trim(tmp_topp)/='once') .AND. ( &
251	trim(tmp_topp)/='never')) THEN
252	point(fileid, iv) = buff_pos + 1
253	buff_pos = buff_pos + buff_sz
254	END IF
255
256	! 4.0 Transfer the frequency of the operations and check
257	! for validity. We have to pay attention to negative values
258	! of the frequency which indicate monthly time-steps.
259	! The strategy is to bring it back to seconds for the tests
260
261	freq_opp(fileid, iv) = pfreq_opp
262	freq_wrt(fileid, iv) = pfreq_wrt
263
264	CALL ioget_calendar_real(un_an, un_jour)
265	IF (pfreq_opp<0) THEN
266	CALL ioget_calendar_real(un_an)
267	test_fopp = pfreq_opp(-1.)un_an/12.*un_jour
268	ELSE
269	test_fopp = pfreq_opp
270	END IF
271	IF (pfreq_wrt<0) THEN
272	CALL ioget_calendar_real(un_an)
273	test_fwrt = pfreq_wrt(-1.)un_an/12.*un_jour
274	ELSE
275	test_fwrt = pfreq_wrt
276	END IF
277
278	! 4.1 Frequency of operations and output should be larger than deltat !
279
280	IF (test_fopp<deltat(fileid)) THEN
281	str70 = 'Frequency of operations should be larger than deltat'
282	WRITE (str71, '("It is not the case for variable ", a, ":", F10.4)') &
283	trim(tmp_name), pfreq_opp
284	str72 = 'PATCH: frequency set to deltat'
285
286	CALL histerr(2, 'histdef', str70, str71, str72)
287
288	freq_opp(fileid, iv) = deltat(fileid)
289	END IF
290
291	IF (test_fwrt<deltat(fileid)) THEN
292	str70 = 'Frequency of output should be larger than deltat'
293	WRITE (str71, '("It is not the case for variable ", a, ":", F10.4)') &
294	trim(tmp_name), pfreq_wrt
295	str72 = 'PATCH: frequency set to deltat'
296
297	CALL histerr(2, 'histdef', str70, str71, str72)
298
299	freq_wrt(fileid, iv) = deltat(fileid)
300	END IF
301
302	! 4.2 First the existence of the operation is tested and then
303	! its compatibility with the choice of frequencies
304
305	IF (trim(tmp_topp)=='inst') THEN
306	IF (test_fopp/=test_fwrt) THEN
307	str70 = 'For instantaneous output the frequency ' // &
308	'of operations and output'
309	WRITE (str71, &
310	'("should be the same, this was not case for variable ", a)') &
311	trim(tmp_name)
312	str72 = 'PATCH: The smalest frequency of both is used'
313	CALL histerr(2, 'histdef', str70, str71, str72)
314	IF (test_fopp<test_fwrt) THEN
315	freq_opp(fileid, iv) = pfreq_opp
316	freq_wrt(fileid, iv) = pfreq_opp
317	ELSE
318	freq_opp(fileid, iv) = pfreq_wrt
319	freq_wrt(fileid, iv) = pfreq_wrt
320	END IF
321	END IF
322	ELSE IF (index(ex_topps, trim(tmp_topp))>0) THEN
323	IF (test_fopp>test_fwrt) THEN
324	str70 = 'For averages the frequency of operations ' // &
325	'should be smaller or equal'
326	WRITE (str71, &
327	'("to that of output. It is not the case for variable ", a)') &
328	trim(tmp_name)
329	str72 = 'PATCH: The output frequency is used for both'
330	CALL histerr(2, 'histdef', str70, str71, str72)
331	freq_opp(fileid, iv) = pfreq_wrt
332	END IF
333	ELSE
334	WRITE (str70, '("Operation on variable ", a, " is unknown")') &
335	trim(tmp_name)
336	WRITE (str71, '("operation requested is:", a)') tmp_topp
337	WRITE (str72, '("File ID:", I3)') fileid
338	CALL histerr(3, 'histdef', str70, str71, str72)
339	END IF
340
341	! 5.0 Initialize other variables of the common
342
343	last_opp(fileid, iv) = itau0(fileid)
344	! - freq_opp(fileid, iv)/2./deltat(fileid)
345	last_wrt(fileid, iv) = itau0(fileid)
346	! - freq_wrt(fileid, iv)/2./deltat(fileid)
347	last_opp_chk(fileid, iv) = itau0(fileid)
348	! - freq_opp(fileid, iv)/2./deltat(fileid)
349	last_wrt_chk(fileid, iv) = itau0(fileid)
350	! - freq_wrt(fileid, iv)/2./deltat(fileid)
351	nb_opp(fileid, iv) = 0
352	nb_wrt(fileid, iv) = 0
353
354	! 6.0 Get the time axis for this variable
355
356	IF (freq_wrt(fileid, iv)>0) THEN
357	WRITE (str10, '(I8.8)') int(freq_wrt(fileid, iv))
358	str40 = trim(tmp_topp) // '_' // trim(str10)
359	ELSE
360	WRITE (str10, '(I2.2, "month")') abs(int(freq_wrt(fileid, iv)))
361	str40 = trim(tmp_topp) // '_' // trim(str10)
362	END IF
363
364	DO i = 1, nb_tax(fileid)
365	tab_str40(i) = tax_name(fileid, i)
366	tab_str40_length(i) = tax_name_length(fileid, i)
367	END DO
368
369	CALL find_str(nb_tax(fileid), tab_str40, tab_str40_length, str40, pos)
370
371	! No time axis for once, l_max, l_min or never operation
372
373	IF ((trim(tmp_topp)/='once') .AND. (trim(tmp_topp)/='never') .AND. ( &
374	trim(tmp_topp)/='l_max') .AND. (trim(tmp_topp)/='l_min')) THEN
375	IF (pos<0) THEN
376	nb_tax(fileid) = nb_tax(fileid) + 1
377	tax_name(fileid, nb_tax(fileid)) = str40
378	tax_name_length(fileid, nb_tax(fileid)) = len_trim(str40)
379	tax_last(fileid, nb_tax(fileid)) = 0
380	var_axid(fileid, iv) = nb_tax(fileid)
381	ELSE
382	var_axid(fileid, iv) = pos
383	END IF
384	ELSE
385	var_axid(fileid, iv) = -99
386	END IF
387
388	! 7.0 prepare frequence of writing and operation
389	! for never or once operation
390
391	IF ((trim(tmp_topp)=='once') .OR. (trim(tmp_topp)=='never')) THEN
392	freq_opp(fileid, iv) = 0.
393	freq_wrt(fileid, iv) = 0.
394	END IF
395
396	END SUBROUTINE histdef
397
398	end module histdef_m