IOIPSL/Histcom/histend.f

module histend_m

  use histcom_var, only: nb_files_max, nb_var_max

  implicit none

  INTEGER, SAVE:: ncvar_ids(nb_files_max, nb_var_max)
  private nb_files_max, nb_var_max

contains

  SUBROUTINE histend(fileid)

    ! This subroutine ends the declaration of variables, sets the time
    ! axes in the NetCDF file and puts it into write mode.

    USE errioipsl, ONLY: histerr
    use histbeg_totreg_m, ONLY: date0, regular
    USE histcom_var, ONLY: freq_opp, freq_wrt, fullop, missing_val, name, &
         nb_tax, nb_var, ncdf_ids, tax_name, tdimid, tid, title, topp, &
         unit_name, var_axid, var_zaxid, xid, yid, zax_ids, zax_name
    USE ioget_calendar_m, ONLY: ioget_calendar_str
    USE ju2ymds_m, ONLY: ju2ymds
    USE netcdf, ONLY: nf90_float, nf90_unlimited
    use netcdf95, only: nf95_def_dim, nf95_def_var, nf95_put_att, nf95_enddef

    INTEGER, INTENT(IN):: fileid ! ID of the file to be worked on

    ! Local:
    INTEGER ncid, varid
    INTEGER ndim, iv, itx, ziv
    INTEGER itax
    INTEGER dims(4), dim_cnt
    INTEGER year, month, day, hours, minutes
    REAL sec
    REAL rtime0
    CHARACTER(len=20) tname, tunit
    CHARACTER(len=42) str30
    CHARACTER(len=80) ttitle
    CHARACTER(len=120) assoc
    CHARACTER(len=70) str70
    CHARACTER(len=3):: cal(12) = (/ 'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN', &
         'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC'/)
    CHARACTER(len=7) tmp_opp

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

    ncid = ncdf_ids(fileid)

    ! 1.0 Create the time axes

    call nf95_def_dim(ncid, 'time_counter', nf90_unlimited, tid(fileid))

    ! 1.1 Define all the time axes needed for this file

    DO itx = 1, nb_tax(fileid)
       IF (nb_tax(fileid)>1) THEN
          str30 = 't_' // tax_name(fileid, itx)
       ELSE
          str30 = 'time_counter'
       END IF
       call nf95_def_var(ncid, str30, nf90_float, tid(fileid), &
            tdimid(fileid, itx))

       rtime0 = date0(fileid)
       CALL ju2ymds(rtime0, year, month, day, sec)

       ! Catch any error induced by a change in calendar

       IF (year <  0) THEN
          year = 2000 + year
       END IF

       hours = int(sec/(60.*60.))
       minutes = int((sec-hours*60.*60.)/60.)
       sec = sec - (hours*60.*60.+minutes*60.)

       WRITE(str70, 7000) year, month, day, hours, minutes, int(sec)
       call nf95_put_att(ncid, tdimid(fileid, itx), 'units', trim(str70))

       CALL ioget_calendar_str(str30)
       call nf95_put_att(ncid, tdimid(fileid, itx), 'calendar', trim(str30))

       call nf95_put_att(ncid, tdimid(fileid, itx), 'title', 'Time')

       call nf95_put_att(ncid, tdimid(fileid, itx), 'long_name', &
            'Time axis')

       WRITE(str70, 7001) year, cal(month), day, hours, minutes, int(sec)
       call nf95_put_att(ncid, tdimid(fileid, itx), 'time_origin', &
            trim(str70))
    END DO

    ! 2.0 declare the variables

    DO iv = 1, nb_var(fileid)

       itax = var_axid(fileid, iv)

       tname = name(fileid, iv)
       tunit = unit_name(fileid, iv)
       ttitle = title(fileid, iv)

       IF (regular(fileid)) THEN
          dims(1:2) = (/ xid(fileid), yid(fileid) /)
          dim_cnt = 2
       ELSE
          dims(1) = xid(fileid)
          dim_cnt = 1
       END IF

       tmp_opp = topp(fileid, iv)
       ziv = var_zaxid(fileid, iv)

       ! 2.1 dimension of field

       IF ((trim(tmp_opp)/='never')) THEN
          IF ((trim(tmp_opp)/='once') .AND. (trim( &
               tmp_opp)/='l_max') .AND. (trim(tmp_opp)/='l_min')) THEN
             IF (ziv==-99) THEN
                ndim = dim_cnt + 1
                dims(dim_cnt+1:dim_cnt+2) = (/ tid(fileid), 0 /)
             ELSE
                ndim = dim_cnt + 2
                dims(dim_cnt+1:dim_cnt+2) = (/ zax_ids(fileid, ziv), &
                     tid(fileid) /)
             END IF
          ELSE
             IF (ziv==-99) THEN
                ndim = dim_cnt
                dims(dim_cnt+1:dim_cnt+2) = (/ 0, 0 /)
             ELSE
                ndim = dim_cnt + 1
                dims(dim_cnt+1:dim_cnt+2) = (/ zax_ids(fileid, ziv), 0 /)
             END IF
          END IF

          call nf95_def_var(ncid, trim(tname), nf90_float, dims(1:abs(ndim)), &
               varid)

          ncvar_ids(fileid, iv) = varid

          call nf95_put_att(ncid, varid, 'units', trim(tunit))
          call nf95_put_att(ncid, varid, 'missing_value', missing_val)
          call nf95_put_att(ncid, varid, 'long_name', trim(ttitle))
          call nf95_put_att(ncid, varid, 'short_name', trim(tname))
          call nf95_put_att(ncid, varid, 'online_operation', trim(fullop( &
               fileid, iv)))

          SELECT CASE (ndim)
          CASE (-3)
             str30 = 'ZYX'
          CASE (2)
             str30 = 'YX'
          CASE (3)
             str30 = 'TYX'
          CASE (4)
             str30 = 'TZYX'
          CASE DEFAULT
             CALL histerr(3, 'histend', &
                  'less than 2 or more than 4 dimensions are not', &
                  'allowed at this stage', ' ')
          END SELECT

          call nf95_put_att(ncid, varid, 'axis', trim(str30))

          assoc = 'nav_lat nav_lon'
          ziv = var_zaxid(fileid, iv)
          IF (ziv>0) THEN
             str30 = zax_name(fileid, ziv)
             assoc = trim(str30) // ' ' // trim(assoc)
          END IF

          IF (itax>0) THEN
             IF (nb_tax(fileid)>1) THEN
                str30 = 't_' // tax_name(fileid, itax)
             ELSE
                str30 = 'time_counter'
             END IF
             assoc = trim(str30) // ' ' // trim(assoc)

             call nf95_put_att(ncid, varid, 'interval_operation', &
                  real(freq_opp(fileid, iv)))
             call nf95_put_att(ncid, varid, 'interval_write', &
                  real(freq_wrt(fileid, iv)))
          END IF
          call nf95_put_att(ncid, varid, 'associate', trim(assoc))
       END IF
    END DO

    ! 3.0 Put the netcdf file into write mode
    call nf95_enddef(ncid)

7000 FORMAT ('seconds since ', I4.4, '-', I2.2, '-', I2.2, ' ', I2.2, ':', &
          I2.2, ':', I2.2)
7001 FORMAT (' ', I4.4, '-', A3, '-', I2.2, ' ', I2.2, ':', I2.2, ':', I2.2)
    
  END SUBROUTINE histend

end module histend_m
1	guez	61	module histend_m
2
3	guez	178	use histcom_var, only: nb_files_max, nb_var_max
4
5	guez	61	implicit none
6
7	guez	178	INTEGER, SAVE:: ncvar_ids(nb_files_max, nb_var_max)
8			private nb_files_max, nb_var_max
9
10	guez	61	contains
11
12	guez	62	SUBROUTINE histend(fileid)
13	guez	61
14	guez	62	! This subroutine ends the declaration of variables, sets the time
15			! axes in the NetCDF file and puts it into write mode.
16	guez	61
17			USE errioipsl, ONLY: histerr
18	guez	178	use histbeg_totreg_m, ONLY: date0, regular
19			USE histcom_var, ONLY: freq_opp, freq_wrt, fullop, missing_val, name, &
20			nb_tax, nb_var, ncdf_ids, tax_name, tdimid, tid, title, topp, &
21			unit_name, var_axid, var_zaxid, xid, yid, zax_ids, zax_name
22	guez	93	USE ioget_calendar_m, ONLY: ioget_calendar_str
23	guez	92	USE ju2ymds_m, ONLY: ju2ymds
24	guez	62	USE netcdf, ONLY: nf90_float, nf90_unlimited
25			use netcdf95, only: nf95_def_dim, nf95_def_var, nf95_put_att, nf95_enddef
26	guez	61
27	guez	62	INTEGER, INTENT(IN):: fileid ! ID of the file to be worked on
28	guez	61
29	guez	62	! Local:
30			INTEGER ncid, varid
31	guez	105	INTEGER ndim, iv, itx, ziv
32	guez	62	INTEGER itax
33			INTEGER dims(4), dim_cnt
34			INTEGER year, month, day, hours, minutes
35			REAL sec
36			REAL rtime0
37			CHARACTER(len=20) tname, tunit
38	guez	106	CHARACTER(len=42) str30
39	guez	62	CHARACTER(len=80) ttitle
40			CHARACTER(len=120) assoc
41			CHARACTER(len=70) str70
42			CHARACTER(len=3):: cal(12) = (/ 'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN', &
43			'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC'/)
44			CHARACTER(len=7) tmp_opp
45	guez	61
46			!---------------------------------------------------------------------
47
48	guez	62	ncid = ncdf_ids(fileid)
49
50	guez	61	! 1.0 Create the time axes
51
52	guez	62	call nf95_def_dim(ncid, 'time_counter', nf90_unlimited, tid(fileid))
53	guez	61
54			! 1.1 Define all the time axes needed for this file
55
56	guez	62	DO itx = 1, nb_tax(fileid)
57			IF (nb_tax(fileid)>1) THEN
58			str30 = 't_' // tax_name(fileid, itx)
59	guez	61	ELSE
60			str30 = 'time_counter'
61			END IF
62	guez	62	call nf95_def_var(ncid, str30, nf90_float, tid(fileid), &
63			tdimid(fileid, itx))
64	guez	61
65	guez	62	rtime0 = date0(fileid)
66	guez	61	CALL ju2ymds(rtime0, year, month, day, sec)
67
68	guez	62	! Catch any error induced by a change in calendar
69	guez	61
70	guez	62	IF (year < 0) THEN
71	guez	61	year = 2000 + year
72			END IF
73
74			hours = int(sec/(60.*60.))
75			minutes = int((sec-hours60.60.)/60.)
76			sec = sec - (hours60.60.+minutes*60.)
77
78	guez	62	WRITE(str70, 7000) year, month, day, hours, minutes, int(sec)
79			call nf95_put_att(ncid, tdimid(fileid, itx), 'units', trim(str70))
80	guez	61
81	guez	93	CALL ioget_calendar_str(str30)
82	guez	62	call nf95_put_att(ncid, tdimid(fileid, itx), 'calendar', trim(str30))
83	guez	61
84	guez	62	call nf95_put_att(ncid, tdimid(fileid, itx), 'title', 'Time')
85	guez	61
86	guez	62	call nf95_put_att(ncid, tdimid(fileid, itx), 'long_name', &
87	guez	61	'Time axis')
88
89	guez	62	WRITE(str70, 7001) year, cal(month), day, hours, minutes, int(sec)
90			call nf95_put_att(ncid, tdimid(fileid, itx), 'time_origin', &
91	guez	61	trim(str70))
92			END DO
93
94			! 2.0 declare the variables
95
96	guez	62	DO iv = 1, nb_var(fileid)
97	guez	61
98	guez	62	itax = var_axid(fileid, iv)
99	guez	61
100	guez	62	tname = name(fileid, iv)
101			tunit = unit_name(fileid, iv)
102			ttitle = title(fileid, iv)
103	guez	61
104	guez	62	IF (regular(fileid)) THEN
105			dims(1:2) = (/ xid(fileid), yid(fileid) /)
106	guez	61	dim_cnt = 2
107			ELSE
108	guez	62	dims(1) = xid(fileid)
109	guez	61	dim_cnt = 1
110			END IF
111
112	guez	62	tmp_opp = topp(fileid, iv)
113			ziv = var_zaxid(fileid, iv)
114	guez	61
115	guez	62	! 2.1 dimension of field
116	guez	61
117			IF ((trim(tmp_opp)/='never')) THEN
118			IF ((trim(tmp_opp)/='once') .AND. (trim( &
119			tmp_opp)/='l_max') .AND. (trim(tmp_opp)/='l_min')) THEN
120			IF (ziv==-99) THEN
121			ndim = dim_cnt + 1
122	guez	62	dims(dim_cnt+1:dim_cnt+2) = (/ tid(fileid), 0 /)
123	guez	61	ELSE
124			ndim = dim_cnt + 2
125	guez	62	dims(dim_cnt+1:dim_cnt+2) = (/ zax_ids(fileid, ziv), &
126			tid(fileid) /)
127	guez	61	END IF
128			ELSE
129			IF (ziv==-99) THEN
130			ndim = dim_cnt
131			dims(dim_cnt+1:dim_cnt+2) = (/ 0, 0 /)
132			ELSE
133			ndim = dim_cnt + 1
134	guez	62	dims(dim_cnt+1:dim_cnt+2) = (/ zax_ids(fileid, ziv), 0 /)
135	guez	61	END IF
136			END IF
137
138	guez	62	call nf95_def_var(ncid, trim(tname), nf90_float, dims(1:abs(ndim)), &
139			varid)
140	guez	61
141	guez	62	ncvar_ids(fileid, iv) = varid
142	guez	61
143	guez	62	call nf95_put_att(ncid, varid, 'units', trim(tunit))
144			call nf95_put_att(ncid, varid, 'missing_value', missing_val)
145			call nf95_put_att(ncid, varid, 'long_name', trim(ttitle))
146			call nf95_put_att(ncid, varid, 'short_name', trim(tname))
147			call nf95_put_att(ncid, varid, 'online_operation', trim(fullop( &
148			fileid, iv)))
149	guez	61
150			SELECT CASE (ndim)
151			CASE (-3)
152			str30 = 'ZYX'
153			CASE (2)
154			str30 = 'YX'
155			CASE (3)
156			str30 = 'TYX'
157			CASE (4)
158			str30 = 'TZYX'
159			CASE DEFAULT
160			CALL histerr(3, 'histend', &
161			'less than 2 or more than 4 dimensions are not', &
162			'allowed at this stage', ' ')
163			END SELECT
164
165	guez	62	call nf95_put_att(ncid, varid, 'axis', trim(str30))
166	guez	61
167			assoc = 'nav_lat nav_lon'
168	guez	62	ziv = var_zaxid(fileid, iv)
169	guez	61	IF (ziv>0) THEN
170	guez	62	str30 = zax_name(fileid, ziv)
171	guez	61	assoc = trim(str30) // ' ' // trim(assoc)
172			END IF
173
174			IF (itax>0) THEN
175	guez	62	IF (nb_tax(fileid)>1) THEN
176			str30 = 't_' // tax_name(fileid, itax)
177	guez	61	ELSE
178			str30 = 'time_counter'
179			END IF
180			assoc = trim(str30) // ' ' // trim(assoc)
181
182	guez	62	call nf95_put_att(ncid, varid, 'interval_operation', &
183			real(freq_opp(fileid, iv)))
184			call nf95_put_att(ncid, varid, 'interval_write', &
185			real(freq_wrt(fileid, iv)))
186	guez	61	END IF
187	guez	62	call nf95_put_att(ncid, varid, 'associate', trim(assoc))
188	guez	61	END IF
189			END DO
190
191	guez	62	! 3.0 Put the netcdf file into write mode
192			call nf95_enddef(ncid)
193	guez	61
194	guez	62	7000 FORMAT ('seconds since ', I4.4, '-', I2.2, '-', I2.2, ' ', I2.2, ':', &
195			I2.2, ':', I2.2)
196			7001 FORMAT (' ', I4.4, '-', A3, '-', I2.2, ' ', I2.2, ':', I2.2, ':', I2.2)
197
198	guez	61	END SUBROUTINE histend
199
200			end module histend_m