IOIPSL/Histcom/histend.f

module histend_m

  implicit none

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 ioipslmpp, ONLY: ioipslmpp_addatt
    USE errioipsl, ONLY: histerr
    USE histcom_var, ONLY: date0, freq_opp, freq_wrt, fullop, &
         missing_val, name, nb_tax, nb_var, ncdf_ids, ncvar_ids, regular, &
         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
    USE calendar, 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 iret, 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=30) 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(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

    ! Add MPP attributes
    CALL ioipslmpp_addatt(ncid)

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