File: test_any_from_asc.f90

package info (click to toggle)
cmor 2.9.1-5
  • links: PTS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 16,332 kB
  • ctags: 9,614
  • sloc: f90: 22,548; ansic: 19,102; python: 7,693; sh: 3,041; makefile: 113; xml: 4
file content (352 lines) | stat: -rw-r--r-- 12,671 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
program main

  USE cmor_users_functions
  implicit none

  integer ncid

  type dims
     integer n
     character(256) name
     character(256) units
     double precision, DIMENSION(:), pointer :: values
     double precision, DIMENSION(:,:), pointer :: bounds     
     type(dims), pointer :: next
  end type dims
  character(256) filein
  type(dims), pointer :: mydims,current,ptimes
  integer ndim,i,j,ntot
!  real, allocatable, dimension(:,:,:):: arrayin
  real, allocatable, dimension(:,:):: arrayin2d
  real, allocatable, dimension(:,:,:):: arrayin3d
  real, allocatable, dimension(:,:,:,:):: arrayin4d
  real, allocatable, dimension(:,:,:,:,:):: arrayin5d
  integer, dimension(7):: dimlength = (/ (1,i=1,7) /)
  integer, PARAMETER::verbosity = 2
  integer ierr
  integer, allocatable, dimension(:) :: myaxis
  integer myvar
  character(50) :: var,units
  double precision bt

  print*, 'Test Code: Welcome to the general from ascii testing code'
  read(5,'(A)') filein
  open(unit=23,file=filein,form='formatted') 
  call allocate_dims(23,mydims,ndim,dimlength,var,units)
  allocate(myaxis(ndim))
  current=>mydims
  ntot=1
  do i =1,ndim
     ntot=ntot*current%n
     current=>current%next
  enddo
  if (ndim.eq.2) then
     allocate(arrayin2d(dimlength(1),dimlength(2)))
     call read_ascii2d(23,mydims, ndim,ntot,arrayin2d)
     print*,'Test Code: allocate data:',shape(arrayin2d)
  else if (ndim.eq.3) then
     allocate(arrayin3d(dimlength(1),dimlength(2),dimlength(3)))
     call read_ascii3d(23,mydims, ndim,ntot,arrayin3d)
     print*,'Test Code: allocate data:',shape(arrayin3d)
  else if (ndim.eq.4) then
     allocate(arrayin4d(dimlength(1),dimlength(2),dimlength(3),dimlength(4)))
     call read_ascii4d(23,mydims, ndim,ntot,arrayin4d)
     print*,'Test Code: allocate data:',shape(arrayin4d)
  else if (ndim.eq.5) then
     call read_ascii5d(23,mydims, ndim,ntot,arrayin5d)
     allocate(arrayin5d(dimlength(1),dimlength(2),dimlength(3),dimlength(4),dimlength(5)))
     print*,'Test Code: allocate data:',shape(arrayin5d)
  endif
  
  
!!$!! Ok here is the part where we define or variable/axis,etc... 
!!$!! Assuming that Karl's code is ok...
!!$
  
  print*,'Test Code: CMOR SETUP'
!!$  
  ierr = cmor_setup(inpath='Test',   &
       netcdf_file_action='replace',                                       &
       set_verbosity=1,                                                    &
       exit_control=1)
    
  print*,'Test Code: CMOR DATASET'
  bt=0.
  ierr = cmor_dataset(                                   &
       outpath='Test',         &
       experiment_id='abrupt 4XCO2',           &
       institution=                                            &
       'GICC (Generic International Climate Center, ' //       &
       ' Geneva, Switzerland)',                                &
       source='GICCM1  2002(giccm_0_brnchT_itea_2, T63L32)',    &
       calendar='noleap',                                      &
       realization=1,                                          &
       history='Output from archive/giccm_03_std_2xCO2_2256.', &
       comment='Equilibrium reached after 30-year spin-up ' // &
       'after which data were output starting with nominal '// &
       'date of January 2030',                                 &
       references='Model described by Koder and Tolkien ' //   &
       '(J. Geophys. Res., 2001, 576-591).  Also ' //          &
       'see http://www.GICC.su/giccm/doc/index.html '  //      &
       ' 2XCO2 simulation described in Dorkey et al. '//       &
       '(Clim. Dyn., 2003, 323-357.)', &
       model_id='GICCM1',forcing='Nat', &
       parent_experiment_rip="N/A",parent_experiment_id="N/A",branch_time=bt,&
       contact="Freddy Krueger",institute_id="PCMDI" )
  
  current=>mydims
  do i = 0,ndim-1
     print*,'Test Code: CMOR AXIS',i
     print*, 'Test Code: Axis Name:',trim(adjustl(current%name))
     if (trim(adjustl(current%name)).eq.'time') then
        print*, 'Test Code: time found'
        ptimes => current
        myaxis(ndim-i)=cmor_axis('Tables/CMIP5_Amon', &
             table_entry=current%name,&
             units=current%units,&
             length=current%n,&
!!$          coord_vals=current%values,&
!!$          cell_bounds=current%bounds, &
             interval='1 month')
     else
        myaxis(ndim-i)=cmor_axis('Tables/CMIP5_Amon', &
             table_entry=current%name,&
             units=current%units,&
             length=current%n,&
             coord_vals=current%values,&
             cell_bounds=current%bounds)
        print*, 'Test Code: not time'
     endif
     current=>current%next
  enddo
  
  print*,'Test Code: CMOR VAR'
  myvar=cmor_variable('Tables/CMIP5_Amon',&
       var,&
       units,&
       myaxis,&
       missing_value=1.e20)

  !! figures out length of dimension other than time

  print*, 'Test Code: time before:',ptimes%values(i:i)
  if (ndim.eq.2) then 
     if (ptimes%name.eq.mydims%name) then
        do i=1,ptimes%n
           print*, 'Test code: Write time',i,ptimes%values(i)
           ierr = cmor_write( &
                var_id        = myvar, &
                data          = arrayin2d(:,i:i), &
                ntimes_passed = 1,   &
                time_vals     = (/ptimes%values(i)/),  &
                time_bnds     = RESHAPE (ptimes%bounds(1:2,i), (/2,1/)) &
                )
        enddo
     else
        print*, 'Test code: Write all times at once'
        ierr = cmor_write( &
             var_id        = myvar, &
             data          = arrayin2d, &
             ntimes_passed = ptimes%n,   &
             time_vals     = ptimes%values,  &
             time_bnds     = ptimes%bounds &
             )
     endif
  else if (ndim.eq.3) then
     if (ptimes%name.eq.mydims%name) then
        do i=1,ptimes%n
           print*, 'Test code: Write time',i,ptimes%values(i)
           ierr = cmor_write( &
                var_id        = myvar, &
                data          = arrayin3d(:,:,i:i), &
                ntimes_passed = 1,   &
                time_vals     = (/ptimes%values(i)/),  &
                time_bnds     = RESHAPE (ptimes%bounds(1:2,i), (/2,1/)) &
                )
        enddo
     else
        print*, 'Test code: Write all times at once',ptimes%units,ptimes%values
        ierr = cmor_write( &
             var_id        = myvar, &
             data          = arrayin3d, &
             ntimes_passed = ptimes%n,   &
             time_vals     = ptimes%values,  &
             time_bnds     = ptimes%bounds &
             )
     endif
  else if (ndim.eq.4) then
     if (ptimes%name.eq.mydims%name) then
        do i=1,ptimes%n
           print*, 'Test code: Write time',i,ptimes%values(i)
           ierr = cmor_write( &
                var_id        = myvar, &
                data          = arrayin4d(:,:,:,i:i), &
                ntimes_passed = 1,   &
                time_vals     = (/ptimes%values(i)/),  &
                time_bnds     = RESHAPE (ptimes%bounds(1:2,i), (/2,1/)) &
                )
        enddo
     else
        print*, 'Test code: Write all times at once',ptimes%units
        ierr = cmor_write( &
             var_id        = myvar, &
             data          = arrayin4d, &
             ntimes_passed = ptimes%n,   &
             time_vals     = ptimes%values,  &
             time_bnds     = ptimes%bounds &
             )
     endif
  else
     if (ptimes%name.eq.mydims%name) then
        do i=1,ptimes%n
           print*, 'Test code: Write time',i,ptimes%values(i)
           ierr = cmor_write( &
                var_id        = myvar, &
                data          = arrayin5d(:,:,:,:,i:i), &
                ntimes_passed = 1,   &
                time_vals     = (/ptimes%values(i)/),  &
                time_bnds     = RESHAPE (ptimes%bounds(1:2,i), (/2,1/)) &
                )
        enddo
     else
        print*, 'Test code: Write all times at once'
        ierr = cmor_write( &
             var_id        = myvar, &
             data          = arrayin5d, &
             ntimes_passed = ptimes%n,   &
             time_vals     = ptimes%values,  &
             time_bnds     = ptimes%bounds &
             )
     endif
  endif
  ierr = cmor_close()

contains
  subroutine allocate_dims(file_id,mydims,ndim,dimlength,var,units)
    implicit none
    integer i,n,j,tmp,file_id
    integer, intent(inout)::ndim
    integer, intent(inout):: dimlength(7)
    type(dims) , pointer :: tmpdims,mydims
    character(50), intent(inout) :: var,units
    read(file_id,'(A)') var
    read(file_id,'(A)') units
    read(file_id,'(I4)') ndim
    n=1
    allocate(mydims)
    tmpdims=>mydims
    do i = 1, ndim
       read(file_id,'(I4)') tmp
       dimlength(4-i)=tmp
       allocate(tmpdims%values(tmp))
       allocate(tmpdims%bounds(2,tmp))
       tmpdims%n=tmp
       allocate(tmpdims%next)
       tmpdims=>tmpdims%next
       n=n*tmp
    enddo
    deallocate(tmpdims)
  end subroutine allocate_dims
  
  subroutine read_ascii2d(file_unit,mydims,ndim,ntot,arrayin)
    implicit none
    type(dims), pointer::  mydims
    real, dimension(:,:),intent(inout) :: arrayin
    type(dims), pointer ::  current
    integer, intent(in)::ndim,file_unit
    integer n,ntot,i,j,k,l
    
    current=>mydims
    ntot=1
    do i =1,ndim
       n=current%n
       ntot=ntot*n
       read(file_unit,'(A)') current%name
       print*, 'Test Code: NAME is:',current%name
       read(file_unit,'(A)') current%units
       print*, 'Test Code: UNITS is:',current%units
       read(file_unit,*) (current%values(j),j=1,n)
       read(file_unit,*) ((current%bounds(j,k),j=1,2),k=1,n)
       print*, 'Test Code: bounds',current%bounds(1,1),current%bounds(1,2)
       current=>current%next
    enddo
    read(file_unit,*) ((arrayin(j,k),j=1,size(arrayin,1)),k=1,size(arrayin,2))
  end subroutine read_ascii2d
  subroutine read_ascii3d(file_unit,mydims,ndim,ntot,arrayin)
    implicit none
    type(dims), pointer::  mydims
    real, dimension(:,:,:),intent(inout) :: arrayin
    type(dims), pointer ::  current
    integer, intent(in)::ndim,file_unit
    integer n,ntot,i,j,k,l
    
    current=>mydims
    ntot=1
    do i =1,ndim
       n=current%n
       ntot=ntot*n
       read(file_unit,'(A)') current%name
       print*, 'Test Code: NAME is:',current%name
       read(file_unit,'(A)') current%units
       print*, 'Test Code: UNITS is:',current%units
       read(file_unit,*) (current%values(j),j=1,n)
       read(file_unit,*) ((current%bounds(j,k),j=1,2),k=1,n)
       print*, 'Test Code: bounds',current%bounds(1,1),current%bounds(1,2)
       current=>current%next
    enddo
    read(file_unit,*) (((arrayin(j,k,l),j=1,size(arrayin,1)),k=1,size(arrayin,2)),l=1,size(arrayin,3))
  end subroutine read_ascii3d
  subroutine read_ascii4d(file_unit,mydims,ndim,ntot,arrayin)
    implicit none
    type(dims), pointer::  mydims
    real, dimension(:,:,:,:),intent(inout) :: arrayin
    type(dims), pointer ::  current
    integer, intent(in)::ndim,file_unit
    integer n,ntot,i,j,k,l,m
    
    current=>mydims
    ntot=1
    do i =1,ndim
       n=current%n
       ntot=ntot*n
       read(file_unit,'(A)') current%name
       print*, 'Test Code: NAME is:',current%name
       read(file_unit,'(A)') current%units
       print*, 'Test Code: UNITS is:',current%units
       read(file_unit,*) (current%values(j),j=1,n)
       read(file_unit,*) ((current%bounds(j,k),j=1,2),k=1,n)
       print*, 'Test Code: bounds',current%bounds(1,1),current%bounds(1,2)
       current=>current%next
    enddo
    read(file_unit,*) ((((arrayin(j,k,l,m),j=1,size(arrayin,1)),k=1,size(arrayin,2)),l=1,size(arrayin,3)),m=1,size(arrayin,4))
  end subroutine read_ascii4d
  subroutine read_ascii5d(file_unit,mydims,ndim,ntot,arrayin)
    implicit none
    type(dims), pointer::  mydims
    real, dimension(:,:,:,:,:),intent(inout) :: arrayin
    type(dims), pointer ::  current
    integer, intent(in)::ndim,file_unit
    integer n,ntot,i,j,k,l,m,o
    
    current=>mydims
    ntot=1
    do i =1,ndim
       n=current%n
       ntot=ntot*n
       read(file_unit,'(A)') current%name
       print*, 'Test Code: NAME is:',current%name
       read(file_unit,'(A)') current%units
       print*, 'Test Code: UNITS is:',current%units
       read(file_unit,*) (current%values(j),j=1,n)
       read(file_unit,*) ((current%bounds(j,k),j=1,2),k=1,n)
       print*, 'Test Code: bounds',current%bounds(1,1),current%bounds(1,2)
       current=>current%next
    enddo
    read(file_unit,*) (((((arrayin(j,k,l,m,o),j=1,size(arrayin,1)),&
         k=1,size(arrayin,2)),l=1,size(arrayin,3)),m=1,size(arrayin,4)),&
         o=1,size(arrayin,5))
  end subroutine read_ascii5d


end program main