/[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/Sources/IOIPSL/Histcom/histdef.f revision 178 by guez, Fri Mar 11 18:47:26 2016 UTC
# Line 1  Line 1 
1  module histdef_m  module histdef_m
2    
3      USE histcom_var, ONLY: nb_files_max, nb_var_max
4    
5    implicit none    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  contains
12    
13    SUBROUTINE histdef(fileid, varname, ptitle, unit, xsize, ysize, &    SUBROUTINE histdef(fileid, varname, ptitle, unit, xsize, ysize, &
14         horiid, pzsize, par_oriz, par_szz, pzid, popp, pfreq_opp, pfreq_wrt)         horiid, pzsize, oriz, szz, zid, opp, pfreq_opp, pfreq_wrt)
15    
16      ! With this subroutine each variable to be archived on the history      ! With this subroutine each variable to be archived on the history
17      ! tape should be declared. It gives the user the choise of      ! tape should be declared. It gives the user the choice of
18      ! operation to be performed on the variables, the frequency of      ! operation to be performed on the variable, the frequency of
19      ! this operation and the frequency of the archiving.      ! this operation and the frequency of the archiving.
20    
21      USE find_str_m, ONLY: find_str      USE buildop_m, ONLY: buildop
     USE mathelp, ONLY: buildop  
22      USE errioipsl, ONLY: histerr      USE errioipsl, ONLY: histerr
23      USE histcom_var, ONLY: buff_pos, deltat, freq_opp, freq_wrt, fullop, &      USE find_str_m, ONLY: find_str
24           full_size, itau0, last_opp, last_opp_chk, last_wrt, last_wrt_chk, &      use histbeg_totreg_m, only: deltat
25           missing_val, name, name_length, nbopp, nbopp_max, nb_hax, nb_opp, &      USE histcom_var, ONLY: freq_opp, freq_wrt, fullop, full_size, itau0, &
26           nb_tax, nb_var, nb_var_max, nb_wrt, nb_zax, point, scal, scsize, &           last_opp, last_opp_chk, last_wrt, last_wrt_chk, missing_val, name, &
27           slab_ori, slab_sz, sopps, tax_last, tax_name, tax_name_length, &           name_length, nbopp, nbopp_max, nb_hax, nb_opp, nb_tax, nb_var, &
28           title, topp, unit_name, var_axid, var_haxid, var_zaxid, zax_name, &           nb_wrt, nb_zax, scal, scsize, slab_ori, slab_sz, sopps, &
29           zax_size, zorig, zsize           tax_last, tax_name, tax_name_length, title, topp, unit_name, &
30      USE ioget_calendar_m, ONLY: ioget_calendar           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      INTEGER, INTENT(IN):: fileid
34      ! (ID of the file the variable should be archived in)      ! (ID of the file the variable should be archived in)
# Line 44  contains Line 50  contains
50    
51      INTEGER, INTENT(IN):: pzsize      INTEGER, INTENT(IN):: pzsize
52      ! (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
53      ! variable and pzid is not used)      ! variable and zid is not used)
54    
55      INTEGER, INTENT(IN):: par_oriz ! Off set of the zoom      INTEGER, INTENT(IN):: oriz ! Off set of the zoom
56      INTEGER, INTENT(IN):: par_szz ! Size of the zoom      INTEGER, INTENT(IN):: szz ! Size of the zoom
57    
58      INTEGER, INTENT(IN):: pzid      INTEGER, INTENT(IN):: zid
59      ! (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.)
60    
61      CHARACTER(len=*), INTENT(IN):: popp      CHARACTER(len=*), INTENT(IN):: opp
62      ! Operation to be performed. The following options exist today:      ! Operation to be performed. The following options exist today:
63      ! inst: keeps instantaneous values for writting      ! inst: keeps instantaneous values for writting
64      ! ave: Computes the average from call between writes      ! ave: Computes the average from call between writes
# Line 120  contains Line 126  contains
126    
127      ! 1.1 decode the operations      ! 1.1 decode the operations
128    
129      fullop(fileid, iv) = popp      fullop(fileid, iv) = opp
130      tmp_str80 = popp      tmp_str80 = opp
131      CALL buildop(tmp_str80, ex_topps, tmp_topp, nbopp_max, missing_val, &      CALL buildop(tmp_str80, ex_topps, tmp_topp, nbopp_max, missing_val, &
132           tmp_sopp, tmp_scal, nbopp(fileid, iv))           tmp_sopp, tmp_scal, nbopp(fileid, iv))
133    
# Line 145  contains Line 151  contains
151      scsize(fileid, iv, :) = (/ xsize, ysize, pzsize/)      scsize(fileid, iv, :) = (/ xsize, ysize, pzsize/)
152    
153      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), &
154           par_oriz/)           oriz/)
155    
156      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), &
157           par_szz/)           szz/)
158    
159      ! 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  ?
160    
# Line 191  contains Line 197  contains
197    
198      ! 2.2 Check the vertical coordinates if needed      ! 2.2 Check the vertical coordinates if needed
199    
200      IF (par_szz>1) THEN      IF (szz>1) THEN
201    
202         ! Does the vertical coordinate exist ?         ! Does the vertical coordinate exist ?
203    
204         IF (pzid>nb_zax(fileid)) THEN         IF (zid>nb_zax(fileid)) THEN
205            WRITE (str70, '("The vertical coordinate chosen for variable ", a)' &            WRITE (str70, '("The vertical coordinate chosen for variable ", a)' &
206                 ) trim(tmp_name)                 ) trim(tmp_name)
207            str71 = ' Does not exist.'            str71 = ' Does not exist.'
# Line 204  contains Line 210  contains
210    
211         ! 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 ?
212    
213         IF (par_szz/=zax_size(fileid, pzid)) THEN         IF (szz/=zax_size(fileid, zid)) THEN
214            str20 = zax_name(fileid, pzid)            str20 = zax_name(fileid, zid)
215            str70 = 'The size of the zoom does not correspond ' // &            WRITE (str71, '("Size of zoom in z:", I4)') szz
                'to the size of the chosen vertical axis'  
           WRITE (str71, '("Size of zoom in z:", I4)') par_szz  
216            WRITE (str72, '("Size declared for axis ", a, ":", I4)') &            WRITE (str72, '("Size declared for axis ", a, ":", I4)') &
217                 trim(str20), zax_size(fileid, pzid)                 trim(str20), zax_size(fileid, zid)
218            CALL histerr(3, 'histdef', str70, str71, str72)            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         END IF
222    
223         ! Is the zoom smaler that the total size of the variable ?         ! Is the zoom smaler that the total size of the variable ?
224    
225         IF (pzsize<par_szz) THEN         IF (pzsize<szz) THEN
226            str20 = zax_name(fileid, pzid)            str20 = zax_name(fileid, zid)
227            str70 = 'The vertical size of variable ' // &            str70 = 'The vertical size of variable ' // &
228                 'is smaller than that of the zoom.'                 'is smaller than that of the zoom.'
229            WRITE (str71, '("Declared vertical size of data:", I5)') pzsize            WRITE (str71, '("Declared vertical size of data:", I5)') pzsize
230            WRITE (str72, '("Size of zoom for variable ", a, " = ", I5)') &            WRITE (str72, '("Size of zoom for variable ", a, " = ", I5)') &
231                 trim(tmp_name), par_szz                 trim(tmp_name), szz
232            CALL histerr(3, 'histdef', str70, str71, str72)            CALL histerr(3, 'histdef', str70, str71, str72)
233         END IF         END IF
234         var_zaxid(fileid, iv) = pzid         var_zaxid(fileid, iv) = zid
235      ELSE      ELSE
236         var_zaxid(fileid, iv) = -99         var_zaxid(fileid, iv) = -99
237      END IF      END IF
# Line 255  contains Line 261  contains
261      freq_opp(fileid, iv) = pfreq_opp      freq_opp(fileid, iv) = pfreq_opp
262      freq_wrt(fileid, iv) = pfreq_wrt      freq_wrt(fileid, iv) = pfreq_wrt
263    
264      CALL ioget_calendar(un_an, un_jour)      CALL ioget_calendar_real(un_an, un_jour)
265      IF (pfreq_opp<0) THEN      IF (pfreq_opp<0) THEN
266         CALL ioget_calendar(un_an)         CALL ioget_calendar_real(un_an)
267         test_fopp = pfreq_opp*(-1.)*un_an/12.*un_jour         test_fopp = pfreq_opp*(-1.)*un_an/12.*un_jour
268      ELSE      ELSE
269         test_fopp = pfreq_opp         test_fopp = pfreq_opp
270      END IF      END IF
271      IF (pfreq_wrt<0) THEN      IF (pfreq_wrt<0) THEN
272         CALL ioget_calendar(un_an)         CALL ioget_calendar_real(un_an)
273         test_fwrt = pfreq_wrt*(-1.)*un_an/12.*un_jour         test_fwrt = pfreq_wrt*(-1.)*un_an/12.*un_jour
274      ELSE      ELSE
275         test_fwrt = pfreq_wrt         test_fwrt = pfreq_wrt
Legend:
Removed from v.62  
changed lines
  Added in v.178
  ViewVC Help
Powered by ViewVC 1.1.21