IOIPSL/Histcom/histdef.f

module histdef_m

  implicit none

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 errioipsl, ONLY: histerr
    USE find_str_m, ONLY: find_str
    USE histcom_var, ONLY: buff_pos, deltat, 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_var_max, nb_wrt, nb_zax, point, 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
    USE buildop_m, ONLY: buildop

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