File: mytest_4d_d_big_array_4.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 (206 lines) | stat: -rw-r--r-- 7,451 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
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
  integer ndim,i,j,ntot,k,l
  double precision, allocatable, dimension(:,:,:,:):: arrayin
!  real, allocatable, dimension(:,:,:,:):: arrayin
  double precision, allocatable :: smallarray(:,:,:)
  integer, dimension(7):: dimlength = (/ (1,i=1,7) /)
  integer, PARAMETER::verbosity = 2
  integer ierr
  integer, allocatable, dimension(:) :: myaxis
  integer myvar
  real amin,amax,mymiss
  double precision bt
  bt=0.
  print*, 'Test Code: hi'
  filein='Test/ta_4D_r.asc'
  open(unit=23,file=filein,form='formatted') 
  call allocate_dims(23,mydims,ndim,dimlength)
  allocate(myaxis(ndim))
  allocate(arrayin(dimlength(1),dimlength(2),dimlength(3),dimlength(4)))
  allocate(smallarray(dimlength(1)+5,dimlength(3)+6,dimlength(4)+7))
  print*,'Test Code: allocate data    :',shape(arrayin),'dims:',dimlength(1),dimlength(2),dimlength(3),dimlength(4)
  print*,'Test Code: allocate data big:',shape(smallarray)
  current=>mydims
  ntot=1
  do i =1,ndim
     ntot=ntot*current%n
     current=>current%next
  enddo
  call read_ascii(23,mydims, ndim,ntot,arrayin)
!!$!! Ok here is the part where we define or variable/axis,etc... 
!!$!! Assuming that Karl's code is ok...
!!$

  print*, 'Test Code: putting everything into the big array contiguous fortran order means faster moving is first element'

  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'
  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='360_day',                                      &
       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='TO',contact="Barry Bonds",institute_id="PCMDI",&
       parent_experiment_rip="N/A",parent_experiment_id="N/A",branch_time=bt)

  current=>mydims
  do i = 0,ndim-1
     print*,'Test Code: CMOR AXIS',i,'AAAAAAA*************************************************************************'
     print*, 'Test Code: Name:',trim(adjustl(current%name))
!!$     print*, 'Test Code: ',current%units
!!$     print*, 'Test Code: ',current%n,size(current%values)
!!$     print*, 'Test Code: ',current%values(1:min(4,size(current%values)))
!!$     print*, 'Test Code: ',current%bounds(1:2,1:min(4,size(current%values)))
     if (trim(adjustl(current%name)).eq.'time') then
        print*, 'Test Code: time found'
  print*, 'Test Code: bounds:',current%bounds,current%units
      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 VARCMOR VARCMOR VARCMOR'

  mymiss=1.e20
  myvar=cmor_variable('Tables/CMIP5_Amon',&
       'ta',&
       'K',&
       myaxis,&
       missing_value=mymiss)

!! figures out length of dimension other than time

  j=ntot/mydims%n
!!$  print*, 'Test Code: &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&'
!!$  print*,'Test Code: before:', shape(arrayin),mydims%n
!!$  print*,'Test Code: before:', shape(arrayin(:,i,:))
!!$  print*, 'Test Code: time before:',mydims%next%values(i:i)
  current=>mydims%next%next
print*, 'Test Code: values:',current%values
print*, 'Test Code: bounds:',current%bounds
print*, 'Test Code: N:',current%n
do i=1,current%n
  smallarray=666. ! initialize smallarray at some bad value
  ierr=1
  !put time i into it
  do l = 1, dimlength(4)
     do k = 1, dimlength(3)
        do j = 1, dimlength(1)
           smallarray(j,k,l)=arrayin(j,i,k,l)
        enddo
     enddo
  enddo
  ierr = cmor_write( &
       var_id        = myvar, &
       data          = smallarray, &
       ntimes_passed = 1 &
       )
enddo
ierr = cmor_close(myvar)

contains
  subroutine allocate_dims(file_id,mydims,ndim,dimlength)
    implicit none
    integer i,n,j,tmp,file_id
    integer, intent(inout)::ndim
    integer, intent(inout):: dimlength(7)
    type(dims) , pointer :: tmpdims,mydims
    read(file_id,'(i8)') ndim
!!$    allocate(dimlength(ndim))
    n=1
    allocate(mydims)
    tmpdims=>mydims
    do i = 1, ndim
       read(file_id,'(I8)') tmp
!!$print*,'Test Code: allocatedat:',tmp
       dimlength(5-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_ascii(file_unit,mydims,ndim,ntot,arrayin)
    implicit none
    type(dims), pointer::  mydims
    double precision, dimension(:,:,:,:),intent(inout) :: arrayin
!    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,trim(adjustl(mydims%name))
       if (current%name.eq."pressure") current%name="plevs"
       read(file_unit,'(A)') 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: ',current%bounds(1,1),current%bounds(1,2)
       current=>current%next
    enddo
print*, 'Test Code: arrayin shape:',shape(arrayin)
    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))
print*, 'Test Code: done!'
print* ,'Test Code: ',trim(adjustl(mydims%name))
  end subroutine read_ascii

end program main