IOIPSL/Histcom/histend.f

module histend_m

  implicit none

contains

  SUBROUTINE histend(pfileid)

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

    ! INPUT

    ! pfileid: ID of the file to be worked on

    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 calendar, ONLY: ioget_calendar, ju2ymds
    USE netcdf, ONLY: nf90_def_dim, nf90_def_var, nf90_enddef, &
         nf90_float, nf90_put_att, nf90_unlimited

    INTEGER, INTENT (IN):: pfileid

    INTEGER:: ncid, ncvarid
    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), DIMENSION (12):: cal = (/ 'JAN', 'FEB', 'MAR', &
         'APR', 'MAY', 'JUN', 'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC'/)
    CHARACTER (len=7):: tmp_opp

    !---------------------------------------------------------------------
    ncid = ncdf_ids(pfileid)

    ! 1.0 Create the time axes

    iret = nf90_def_dim(ncid, 'time_counter', nf90_unlimited, tid(pfileid))

    ! 1.1 Define all the time axes needed for this file

    DO itx = 1, nb_tax(pfileid)
       dims(1) = tid(pfileid)
       IF (nb_tax(pfileid)>1) THEN
          str30 = 't_' // tax_name(pfileid, itx)
       ELSE
          str30 = 'time_counter'
       END IF
       iret = nf90_def_var(ncid, str30, nf90_float, dims(1), &
            tdimid(pfileid, itx))

       !   To transform the current itau into a real date and take it
       !   as the origin of the file requires the time counter to change.
       !   Thus it is an operation the user has to ask for.
       !   This function should thus only be re-instated
       !   if there is a ioconf routine to control it.

       ! rtime0 = itau2date(itau0(pfileid), date0(pfileid), deltat(pfileid))
       rtime0 = date0(pfileid)

       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)
       iret = nf90_put_att(ncid, tdimid(pfileid, itx), 'units', trim(str70))

       CALL ioget_calendar(str30)
       iret = nf90_put_att(ncid, tdimid(pfileid, itx), 'calendar', trim(str30))

       iret = nf90_put_att(ncid, tdimid(pfileid, itx), 'title', 'Time')

       iret = nf90_put_att(ncid, tdimid(pfileid, itx), 'long_name', &
            'Time axis')

       WRITE (str70, 7001) year, cal(month), day, hours, minutes, int(sec)
       iret = nf90_put_att(ncid, tdimid(pfileid, itx), 'time_origin', &
            trim(str70))
    END DO

    ! The formats we need

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)

    ! 2.0 declare the variables

    DO iv = 1, nb_var(pfileid)

       itax = var_axid(pfileid, iv)

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

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

       tmp_opp = topp(pfileid, iv)
       ziv = var_zaxid(pfileid, 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(pfileid), 0 /)
             ELSE
                ndim = dim_cnt + 2
                dims(dim_cnt+1:dim_cnt+2) = (/ zax_ids(pfileid, ziv), &
                     tid(pfileid) /)
             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(pfileid, ziv), 0 /)
             END IF
          END IF

          iret = nf90_def_var(ncid, trim(tname), nf90_float, dims(1:abs(ndim)), &
               ncvarid)

          ncvar_ids(pfileid, iv) = ncvarid

          iret = nf90_put_att(ncid, ncvarid, 'units', trim(tunit))

          iret = nf90_put_att(ncid, ncvarid, 'missing_value', &
               real(missing_val))
          iret = nf90_put_att(ncid, ncvarid, 'long_name', trim(ttitle))

          iret = nf90_put_att(ncid, ncvarid, 'short_name', trim(tname))

          iret = nf90_put_att(ncid, ncvarid, 'online_operation', trim(fullop( &
               pfileid, 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

          iret = nf90_put_att(ncid, ncvarid, 'axis', trim(str30))

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

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

             iret = nf90_put_att(ncid, ncvarid, 'interval_operation', &
                  real(freq_opp(pfileid, iv)))
             iret = nf90_put_att(ncid, ncvarid, 'interval_write', real(freq_wrt( &
                  pfileid, iv)))
          END IF
          iret = nf90_put_att(ncid, ncvarid, 'associate', trim(assoc))
       END IF
    END DO

    !  Add MPP attributes

    CALL ioipslmpp_addatt(ncid)

    ! 3.0 Put the netcdf file into wrte mode

    iret = nf90_enddef(ncid)

  END SUBROUTINE histend

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