/[lmdze]/trunk/Sources/IOIPSL/Histcom/histdef.f
ViewVC logotype

Diff of /trunk/Sources/IOIPSL/Histcom/histdef.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/libf/IOIPSL/Histcom/histdef.f90 revision 62 by guez, Thu Jul 26 14:37:37 2012 UTC trunk/IOIPSL/Histcom/histdef.f revision 93 by guez, Tue Apr 1 15:50:48 2014 UTC
# Line 5  module histdef_m Line 5  module histdef_m
5  contains  contains
6    
7    SUBROUTINE histdef(fileid, varname, ptitle, unit, xsize, ysize, &    SUBROUTINE histdef(fileid, varname, ptitle, unit, xsize, ysize, &
8         horiid, pzsize, par_oriz, par_szz, pzid, popp, pfreq_opp, pfreq_wrt)         horiid, pzsize, oriz, szz, zid, opp, pfreq_opp, pfreq_wrt)
9    
10      ! With this subroutine each variable to be archived on the history      ! With this subroutine each variable to be archived on the history
11      ! tape should be declared. It gives the user the choise of      ! tape should be declared. It gives the user the choice of
12      ! operation to be performed on the variables, the frequency of      ! operation to be performed on the variable, the frequency of
13      ! this operation and the frequency of the archiving.      ! this operation and the frequency of the archiving.
14    
     USE find_str_m, ONLY: find_str  
     USE mathelp, ONLY: buildop  
15      USE errioipsl, ONLY: histerr      USE errioipsl, ONLY: histerr
16        USE find_str_m, ONLY: find_str
17      USE histcom_var, ONLY: buff_pos, deltat, freq_opp, freq_wrt, fullop, &      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, &           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, &           missing_val, name, name_length, nbopp, nbopp_max, nb_hax, nb_opp, &
# Line 22  contains Line 21  contains
21           slab_ori, slab_sz, sopps, tax_last, tax_name, tax_name_length, &           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, &           title, topp, unit_name, var_axid, var_haxid, var_zaxid, zax_name, &
23           zax_size, zorig, zsize           zax_size, zorig, zsize
24      USE ioget_calendar_m, ONLY: ioget_calendar      USE ioget_calendar_m, ONLY: ioget_calendar_real
25        USE mathelp, ONLY: buildop
26    
27      INTEGER, INTENT(IN):: fileid      INTEGER, INTENT(IN):: fileid
28      ! (ID of the file the variable should be archived in)      ! (ID of the file the variable should be archived in)
# Line 44  contains Line 44  contains
44    
45      INTEGER, INTENT(IN):: pzsize      INTEGER, INTENT(IN):: pzsize
46      ! (Size in Z direction (If 1 then no axis is declared for this      ! (Size in Z direction (If 1 then no axis is declared for this
47      ! variable and pzid is not used)      ! variable and zid is not used)
48    
49      INTEGER, INTENT(IN):: par_oriz ! Off set of the zoom      INTEGER, INTENT(IN):: oriz ! Off set of the zoom
50      INTEGER, INTENT(IN):: par_szz ! Size of the zoom      INTEGER, INTENT(IN):: szz ! Size of the zoom
51    
52      INTEGER, INTENT(IN):: pzid      INTEGER, INTENT(IN):: zid
53      ! (ID of the vertical axis to use. It has to have the size of the zoom.)      ! (ID of the vertical axis to use. It has to have the size of the zoom.)
54    
55      CHARACTER(len=*), INTENT(IN):: popp      CHARACTER(len=*), INTENT(IN):: opp
56      ! Operation to be performed. The following options exist today:      ! Operation to be performed. The following options exist today:
57      ! inst: keeps instantaneous values for writting      ! inst: keeps instantaneous values for writting
58      ! ave: Computes the average from call between writes      ! ave: Computes the average from call between writes
# Line 120  contains Line 120  contains
120    
121      ! 1.1 decode the operations      ! 1.1 decode the operations
122    
123      fullop(fileid, iv) = popp      fullop(fileid, iv) = opp
124      tmp_str80 = popp      tmp_str80 = opp
125      CALL buildop(tmp_str80, ex_topps, tmp_topp, nbopp_max, missing_val, &      CALL buildop(tmp_str80, ex_topps, tmp_topp, nbopp_max, missing_val, &
126           tmp_sopp, tmp_scal, nbopp(fileid, iv))           tmp_sopp, tmp_scal, nbopp(fileid, iv))
127    
# Line 145  contains Line 145  contains
145      scsize(fileid, iv, :) = (/ xsize, ysize, pzsize/)      scsize(fileid, iv, :) = (/ xsize, ysize, pzsize/)
146    
147      zorig(fileid, iv, 1:3) = (/ slab_ori(fileid, 1), slab_ori(fileid, 2), &      zorig(fileid, iv, 1:3) = (/ slab_ori(fileid, 1), slab_ori(fileid, 2), &
148           par_oriz/)           oriz/)
149    
150      zsize(fileid, iv, 1:3) = (/ slab_sz(fileid, 1), slab_sz(fileid, 2), &      zsize(fileid, iv, 1:3) = (/ slab_sz(fileid, 1), slab_sz(fileid, 2), &
151           par_szz/)           szz/)
152    
153      ! Is the size of the full array the same as that of the coordinates  ?      ! Is the size of the full array the same as that of the coordinates  ?
154    
# Line 191  contains Line 191  contains
191    
192      ! 2.2 Check the vertical coordinates if needed      ! 2.2 Check the vertical coordinates if needed
193    
194      IF (par_szz>1) THEN      IF (szz>1) THEN
195    
196         ! Does the vertical coordinate exist ?         ! Does the vertical coordinate exist ?
197    
198         IF (pzid>nb_zax(fileid)) THEN         IF (zid>nb_zax(fileid)) THEN
199            WRITE (str70, '("The vertical coordinate chosen for variable ", a)' &            WRITE (str70, '("The vertical coordinate chosen for variable ", a)' &
200                 ) trim(tmp_name)                 ) trim(tmp_name)
201            str71 = ' Does not exist.'            str71 = ' Does not exist.'
# Line 204  contains Line 204  contains
204    
205         ! Is the vertical size of the variable equal to that of the axis ?         ! Is the vertical size of the variable equal to that of the axis ?
206    
207         IF (par_szz/=zax_size(fileid, pzid)) THEN         IF (szz/=zax_size(fileid, zid)) THEN
208            str20 = zax_name(fileid, pzid)            str20 = zax_name(fileid, zid)
209            str70 = 'The size of the zoom does not correspond ' // &            str70 = 'The size of the zoom does not correspond ' // &
210                 'to the size of the chosen vertical axis'                 'to the size of the chosen vertical axis'
211            WRITE (str71, '("Size of zoom in z:", I4)') par_szz            WRITE (str71, '("Size of zoom in z:", I4)') szz
212            WRITE (str72, '("Size declared for axis ", a, ":", I4)') &            WRITE (str72, '("Size declared for axis ", a, ":", I4)') &
213                 trim(str20), zax_size(fileid, pzid)                 trim(str20), zax_size(fileid, zid)
214            CALL histerr(3, 'histdef', str70, str71, str72)            CALL histerr(3, 'histdef', str70, str71, str72)
215         END IF         END IF
216    
217         ! Is the zoom smaler that the total size of the variable ?         ! Is the zoom smaler that the total size of the variable ?
218    
219         IF (pzsize<par_szz) THEN         IF (pzsize<szz) THEN
220            str20 = zax_name(fileid, pzid)            str20 = zax_name(fileid, zid)
221            str70 = 'The vertical size of variable ' // &            str70 = 'The vertical size of variable ' // &
222                 'is smaller than that of the zoom.'                 'is smaller than that of the zoom.'
223            WRITE (str71, '("Declared vertical size of data:", I5)') pzsize            WRITE (str71, '("Declared vertical size of data:", I5)') pzsize
224            WRITE (str72, '("Size of zoom for variable ", a, " = ", I5)') &            WRITE (str72, '("Size of zoom for variable ", a, " = ", I5)') &
225                 trim(tmp_name), par_szz                 trim(tmp_name), szz
226            CALL histerr(3, 'histdef', str70, str71, str72)            CALL histerr(3, 'histdef', str70, str71, str72)
227         END IF         END IF
228         var_zaxid(fileid, iv) = pzid         var_zaxid(fileid, iv) = zid
229      ELSE      ELSE
230         var_zaxid(fileid, iv) = -99         var_zaxid(fileid, iv) = -99
231      END IF      END IF
# Line 255  contains Line 255  contains
255      freq_opp(fileid, iv) = pfreq_opp      freq_opp(fileid, iv) = pfreq_opp
256      freq_wrt(fileid, iv) = pfreq_wrt      freq_wrt(fileid, iv) = pfreq_wrt
257    
258      CALL ioget_calendar(un_an, un_jour)      CALL ioget_calendar_real(un_an, un_jour)
259      IF (pfreq_opp<0) THEN      IF (pfreq_opp<0) THEN
260         CALL ioget_calendar(un_an)         CALL ioget_calendar_real(un_an)
261         test_fopp = pfreq_opp*(-1.)*un_an/12.*un_jour         test_fopp = pfreq_opp*(-1.)*un_an/12.*un_jour
262      ELSE      ELSE
263         test_fopp = pfreq_opp         test_fopp = pfreq_opp
264      END IF      END IF
265      IF (pfreq_wrt<0) THEN      IF (pfreq_wrt<0) THEN
266         CALL ioget_calendar(un_an)         CALL ioget_calendar_real(un_an)
267         test_fwrt = pfreq_wrt*(-1.)*un_an/12.*un_jour         test_fwrt = pfreq_wrt*(-1.)*un_an/12.*un_jour
268      ELSE      ELSE
269         test_fwrt = pfreq_wrt         test_fwrt = pfreq_wrt
Legend:
Removed from v.62  
changed lines
  Added in v.93
  ViewVC Help
Powered by ViewVC 1.1.21