[1402] | 1 | !M. Indurain & E. Millour |
---|
| 2 | !March 2015 |
---|
| 3 | |
---|
| 4 | PROGRAM spectra_analysis |
---|
| 5 | |
---|
| 6 | !Compute energy spectrum of a 2d wind field with spherepack routines. |
---|
| 7 | !v = sum(n=1..nlat-1) 0.5*b(0,n)*B(0,n)+0.5*c(0,n)*C(0,n) + sum(m=1..mmax-1)sum(n=m..nlat-1) b(m,n)*B(m,n)+c(m,n)*C(m,n) |
---|
| 8 | !where B(m,n) and C(m,n) are vector spherical harmonics |
---|
| 9 | !Then energy spectra is defined as: |
---|
| 10 | !E(n) = 0.5*|b(0,n)|^2 + 0.5*|c(0,n)|^2 + sum(m=1..n) |b(m,n)|^2 + |c(m,n)|^2 |
---|
| 11 | |
---|
| 12 | !Wind field read from netcdf file follows lmdz convention: |
---|
| 13 | ! u(nlong+1,nlat) zonal eastward wind, v(nlong+1,nlat) latitudinal wind |
---|
| 14 | !Wind field needed for spherepack routines must be like: |
---|
| 15 | ! u(nlat,nlong) zonal eastward wind, v(nlong,nlat) colatitudinal wind (from North pole) |
---|
| 16 | |
---|
| 17 | use netcdf |
---|
| 18 | |
---|
| 19 | implicit none |
---|
| 20 | |
---|
| 21 | !Physical grid |
---|
| 22 | integer :: nlat,nlong,nlongp1,nalt,ntime |
---|
| 23 | double precision, dimension(:,:), allocatable :: merid_wind,zonal_wind !spherepack convention |
---|
| 24 | double precision, dimension(:,:), allocatable :: merid_wind_lmdz,zonal_wind_lmdz !lmdz convention |
---|
| 25 | !Spectral grid |
---|
| 26 | integer :: mmax !spectra truncation mmax=min(nalt,nlong/2) or min(nalt,(nlong+1)/2) |
---|
| 27 | double precision, dimension (:,:), allocatable :: br,bi,cr,ci !spectra coefficients |
---|
| 28 | double precision, dimension (:,:), allocatable :: norm,norm_b,norm_c !norm of spectra coefficients |
---|
| 29 | double precision, dimension (:), allocatable :: spectra,spectra_b,spectra_c |
---|
| 30 | double precision, dimension (:,:), allocatable :: spectra_config,spectra_b_config,spectra_c_config |
---|
| 31 | double precision, dimension (:,:), allocatable :: spectra_global,spectra_b_global,spectra_c_global |
---|
| 32 | !Spherepack declarations |
---|
| 33 | integer :: ierror,lvhaec,ldwork,lwork,l1,l2,nt=1,ityp=0,idvw,jdvw,mdab,ndab |
---|
| 34 | double precision, dimension (:), allocatable :: wvhaec,work |
---|
| 35 | double precision, dimension (:), allocatable :: dwork |
---|
| 36 | !Netcdf stuff |
---|
| 37 | integer :: idfile,idmerid_wind,idzonal_wind |
---|
| 38 | integer :: idlat,idlong,idalt,idtime |
---|
| 39 | !Input arguments |
---|
| 40 | character (len=100), dimension(:), allocatable :: arg |
---|
| 41 | character (len=100) :: file_netcdf,file_spectra |
---|
| 42 | integer :: n_indt,n_indz,meant,meanz |
---|
| 43 | integer, dimension(:), allocatable :: tab_indt,tab_indz |
---|
| 44 | character (len=100) :: name_u,name_v,name_lat,name_long,name_alt,name_time |
---|
| 45 | character (len=100) :: tab_name_u(4)=(/'u','U','vitu','zonal_wind'/) |
---|
| 46 | character (len=100) :: tab_name_v(4)=(/'v','V','vitv','merid_wind'/) |
---|
| 47 | character (len=100) :: tab_name_lat(2)=(/'latitude','lat'/) |
---|
| 48 | character (len=100) :: tab_name_long(2)=(/'longitude','lon'/) |
---|
| 49 | character (len=100) :: tab_name_alt(3)=(/'altitude','alt','presnivs'/) |
---|
| 50 | character (len=100) :: tab_name_time(3)=(/'time','Time','time_counter'/) |
---|
| 51 | logical :: is_div_rot |
---|
| 52 | integer :: narg |
---|
| 53 | !Other |
---|
| 54 | integer :: i,j,t,z,mt,mz |
---|
| 55 | integer :: number_config !number of (t,z) configurations wanted by user (from 1 to n_indt*n_indz)) |
---|
| 56 | integer :: number_local !number of (t,z) sub-configurations to mean (from 1 to (meant+1)*(meanz+1)) |
---|
| 57 | integer :: number_global !number of total (t,z) configurations to compute (from 1 to n_indt*n_indz*(meant+1)*(meanz+1)) |
---|
| 58 | logical :: is_file,first_reading=.true. |
---|
| 59 | integer, dimension(:), allocatable :: tmp_tab_int |
---|
| 60 | character (len=100) :: tmp_char |
---|
| 61 | |
---|
| 62 | !********** |
---|
| 63 | !Initialisation |
---|
| 64 | file_netcdf = '??@@??' |
---|
| 65 | file_spectra = 'spectra' |
---|
| 66 | n_indt = 0 |
---|
| 67 | n_indz = 0 |
---|
| 68 | allocate(tab_indt(20)) |
---|
| 69 | allocate(tab_indz(20)) |
---|
| 70 | allocate(tmp_tab_int(20)) |
---|
| 71 | tab_indt(:) = 1 |
---|
| 72 | tab_indz(:) = 1 |
---|
| 73 | meant = 0 |
---|
| 74 | meanz = 0 |
---|
| 75 | name_u = '??@@??' |
---|
| 76 | name_v = '??@@??' |
---|
| 77 | name_lat = '??@@??' |
---|
| 78 | name_long = '??@@??' |
---|
| 79 | name_alt = '??@@??' |
---|
| 80 | name_time = '??@@??' |
---|
| 81 | is_div_rot=.false. |
---|
| 82 | |
---|
| 83 | !********** |
---|
| 84 | !Input reading |
---|
| 85 | narg = command_argument_count() |
---|
| 86 | allocate(arg(narg)) |
---|
| 87 | do i = 1, narg |
---|
| 88 | call get_command_argument(i,arg(i)) |
---|
| 89 | end do |
---|
| 90 | i = 1 |
---|
| 91 | do while (i .le. narg) |
---|
| 92 | if (arg(i) == '-o' .or. arg(i) == '-t' .or. arg(i) == '-z' .or. arg(i) == '-mt' .or. arg(i) == '-mz'& |
---|
| 93 | .or. arg(i) == '-u' .or. arg(i) == '-v' .or. arg(i) == '-lat' .or. arg(i) == '-lon' & |
---|
| 94 | .or. arg(i) == '-alt' .or. arg(i) == '-time') then |
---|
| 95 | select case(arg(i)) |
---|
| 96 | case('-t') |
---|
| 97 | n_indt = n_indt + 1 |
---|
| 98 | read(arg(i+1),'(i10)' ) tab_indt(n_indt) !temporal indice |
---|
| 99 | case('-z') |
---|
| 100 | n_indz = n_indz + 1 |
---|
| 101 | read(arg(i+1),'(i10)' ) tab_indz(n_indz) !vertical indice |
---|
| 102 | case('-mt') |
---|
| 103 | read(arg(i+1),'(i10)' ) meant !extent of temporal mean |
---|
| 104 | case('-mz') |
---|
| 105 | read(arg(i+1),'(i10)' ) meanz !extent of vertical mean |
---|
| 106 | case('-o') |
---|
| 107 | file_spectra=arg(i+1) !spectra file |
---|
| 108 | case('-u') |
---|
| 109 | read(arg(i+1),'(a100)' ) name_u !name of zonal wind |
---|
| 110 | case('-v') |
---|
| 111 | read(arg(i+1),'(a100)' ) name_v !name of meridional wind |
---|
| 112 | case('-lat') |
---|
| 113 | read(arg(i+1),'(a100)' ) name_lat !name of latitude axis |
---|
| 114 | case('-lon') |
---|
| 115 | read(arg(i+1),'(a100)' ) name_long !name of longitude axis |
---|
| 116 | case('-alt') |
---|
| 117 | read(arg(i+1),'(a100)' ) name_alt !name of altitude axis |
---|
| 118 | case('-time') |
---|
| 119 | read(arg(i+1),'(a100)' ) name_time !name of time axis |
---|
| 120 | end select |
---|
| 121 | i = i + 2 |
---|
| 122 | elseif (arg(i) == '-divrot') then |
---|
| 123 | is_div_rot = .true. |
---|
| 124 | i = i + 1 |
---|
| 125 | elseif (arg(i) == '-h' .or. arg(i) == '--help') then |
---|
[1426] | 126 | print*,'Usage' |
---|
| 127 | print*,'spectra_analysis netcdfFile [option]' |
---|
| 128 | print*,'[-h or --help] : brief help' |
---|
| 129 | print*,'[-t int] : temporal indice (default: 1)' |
---|
| 130 | print*,'[-z int] : vertical indice (default: 1)' |
---|
| 131 | print*,'[-mt int] : extent of temporal mean (default: 0)' |
---|
| 132 | print*,'[-mz int] : extent of vertical mean (default: 0)' |
---|
| 133 | print*,'[-o str] : output spectra file name (default: spectra)' |
---|
| 134 | print*,'[-u str] : name of zonal wind in netcdf file' |
---|
| 135 | print*,'[-v str] : name of meridional wind in netcdf file' |
---|
| 136 | print*,'[-lat str] : name of latitude field in netcdf file' |
---|
| 137 | print*,'[-lon str] : name of longitude field in netcdf file' |
---|
| 138 | print*,'[-alt str] : name of altitude field in netcdf file. ''none'' if no altitude axis.' |
---|
| 139 | print*,'[-time str] : name of time field in netcdf file. ''none'' if no time axis.' |
---|
| 140 | print*,'[-divrot] : total, divergence and vorticity spectra coefficient in output file' |
---|
| 141 | print*,'' |
---|
| 142 | print*,'Compute the kinetic energy spectrum of a wind field on a longitude-latitude grid.' |
---|
| 143 | print*,'The grid must have a redundant point in longitude.' |
---|
| 144 | print*,'Ideally the analysis works better on a symetric grid (2N points in longitude and N points in latitude).' |
---|
| 145 | print*,'The output text file (called spectra by default) give the decomposition' |
---|
| 146 | print*,'of the velocity on the vectorial spherical harmonic basis.' |
---|
[1402] | 147 | stop 'End help' |
---|
| 148 | else |
---|
| 149 | file_netcdf = arg(i) |
---|
| 150 | i = i + 1 |
---|
| 151 | end if |
---|
| 152 | end do |
---|
| 153 | |
---|
| 154 | !********** |
---|
| 155 | !Check input/output files |
---|
| 156 | inquire(file=trim(file_netcdf),exist=is_file) |
---|
| 157 | if (.not. is_file) then |
---|
| 158 | print*,"no netcdf file: ",trim(file_netcdf) |
---|
| 159 | stop "Stopped" |
---|
| 160 | end if |
---|
| 161 | call system('rm -f '//trim(file_spectra)) |
---|
| 162 | |
---|
| 163 | !********** |
---|
| 164 | !Netcdf file dimensions |
---|
| 165 | ierror=nf90_open(trim(file_netcdf),NF90_NOWRITE,idfile) |
---|
| 166 | |
---|
| 167 | ierror=-99999 |
---|
| 168 | i=0 |
---|
| 169 | ierror=nf90_inq_dimid(idfile,trim(name_lat),idlat) !try user named latitude |
---|
| 170 | do while (ierror /= 0 .and. i <= size(tab_name_lat)-1)!try automatic named latitude |
---|
| 171 | i=i+1 |
---|
| 172 | ierror=nf90_inq_dimid(idfile,trim(tab_name_lat(i)),idlat) |
---|
| 173 | end do |
---|
| 174 | if (ierror == 0) then |
---|
| 175 | ierror=nf90_inquire_dimension(idfile,idlat,tmp_char,nlat) |
---|
| 176 | else |
---|
| 177 | print*,'latitude dimension not found!' |
---|
[1404] | 178 | stop ' must have this... use ''-lat latitudefieldname'' option.' |
---|
[1402] | 179 | end if |
---|
| 180 | |
---|
| 181 | ierror=-99999 |
---|
| 182 | i=0 |
---|
| 183 | ierror=nf90_inq_dimid(idfile,trim(name_long),idlong) !try user named longitude |
---|
| 184 | do while (ierror /= 0 .and. i <= size(tab_name_long)-1) !try automatic named longitude |
---|
| 185 | i=i+1 |
---|
| 186 | ierror=nf90_inq_dimid(idfile,trim(tab_name_long(i)),idlong) |
---|
| 187 | end do |
---|
| 188 | if (ierror == 0) then |
---|
| 189 | ierror=nf90_inquire_dimension(idfile,idlong,tmp_char,nlongp1) |
---|
| 190 | else |
---|
| 191 | print*,'longitude dimension not found!' |
---|
[1404] | 192 | stop ' must have this... use ''-lon longitudefieldname'' option.' |
---|
[1402] | 193 | end if |
---|
| 194 | |
---|
| 195 | ierror=-99999 |
---|
| 196 | i=0 |
---|
| 197 | ierror=nf90_inq_dimid(idfile,trim(name_alt),idalt) !try user named altitude |
---|
| 198 | do while (ierror /= 0 .and. i <= size(tab_name_alt)-1)!try automatic named altitude |
---|
| 199 | i=i+1 |
---|
| 200 | ierror=nf90_inq_dimid(idfile,trim(tab_name_alt(i)),idalt) |
---|
| 201 | end do |
---|
| 202 | if (ierror == 0) then |
---|
| 203 | ierror=nf90_inquire_dimension(idfile,idalt,tmp_char,nalt) |
---|
| 204 | else |
---|
| 205 | if (name_alt == 'none') then |
---|
| 206 | print*,'netcdf file without altitude axis: all the same.' |
---|
| 207 | else |
---|
| 208 | print*,'altitude dimension not found!' |
---|
[1404] | 209 | stop ' if no altitude axis, use ''-alt none'' option...' |
---|
[1402] | 210 | end if |
---|
| 211 | end if |
---|
| 212 | |
---|
| 213 | ierror=-99999 |
---|
| 214 | i=0 |
---|
| 215 | ierror=nf90_inq_dimid(idfile,trim(name_time),idtime) !try user named time |
---|
| 216 | do while (ierror /= 0 .and. i <= size(tab_name_time)-1) !try automatic named time |
---|
| 217 | i=i+1 |
---|
| 218 | ierror=nf90_inq_dimid(idfile,trim(tab_name_time(i)),idtime) |
---|
| 219 | end do |
---|
| 220 | if (ierror == 0) then |
---|
| 221 | ierror=nf90_inquire_dimension(idfile,idtime,tmp_char,ntime) |
---|
| 222 | else |
---|
| 223 | if (name_time == 'none') then |
---|
| 224 | print*,'netcdf file without time axis: all the same.' |
---|
| 225 | else |
---|
| 226 | print*,'time dimension not found!' |
---|
[1404] | 227 | stop ' if no time axis, use ''-time none'' option...' |
---|
[1402] | 228 | end if |
---|
| 229 | end if |
---|
| 230 | |
---|
| 231 | !********** |
---|
| 232 | !Check input indices and add average indices |
---|
| 233 | if (n_indt == 0) n_indt = 1 |
---|
| 234 | tmp_tab_int(:) = tab_indt(:) |
---|
| 235 | deallocate(tab_indt) |
---|
| 236 | allocate(tab_indt(n_indt*(meant+1))) |
---|
| 237 | do t = 1,n_indt |
---|
| 238 | do mt = 0,meant |
---|
| 239 | tab_indt((t-1)*(meant+1)+1+mt) = tmp_tab_int(t)+mt |
---|
| 240 | end do |
---|
| 241 | end do |
---|
| 242 | do t = 1,n_indt*(meant+1) |
---|
| 243 | if (tab_indt(t) > ntime .or. tab_indt(t) < 1) tab_indt(t) = 1 |
---|
| 244 | end do |
---|
| 245 | |
---|
| 246 | if (n_indz == 0) n_indz = 1 |
---|
| 247 | tmp_tab_int(:) = tab_indz(:) |
---|
| 248 | deallocate(tab_indz) |
---|
| 249 | allocate(tab_indz(n_indz*(meanz+1))) |
---|
| 250 | do z = 1,n_indz |
---|
| 251 | do mz = 0,meanz |
---|
| 252 | tab_indz((z-1)*(meanz+1)+1+mz) = tmp_tab_int(z)+mz |
---|
| 253 | end do |
---|
| 254 | end do |
---|
| 255 | do z = 1,n_indz*(meanz+1) |
---|
| 256 | if (tab_indz(z) > nalt .or. tab_indz(z) < 1) tab_indz(z) = 1 |
---|
| 257 | end do |
---|
| 258 | |
---|
| 259 | !********** |
---|
| 260 | !Loop over time and altitude indices |
---|
| 261 | allocate(spectra_config(nlat,n_indt*n_indz)) |
---|
| 262 | allocate(spectra_b_config(nlat,n_indt*n_indz)) |
---|
| 263 | allocate(spectra_c_config(nlat,n_indt*n_indz)) |
---|
| 264 | allocate(spectra_global(nlat,n_indt*(meant+1)*n_indz*(meanz+1))) |
---|
| 265 | allocate(spectra_b_global(nlat,n_indt*(meant+1)*n_indz*(meanz+1))) |
---|
| 266 | allocate(spectra_c_global(nlat,n_indt*(meant+1)*n_indz*(meanz+1))) |
---|
| 267 | do t = 1,n_indt |
---|
| 268 | do z = 1,n_indz |
---|
| 269 | number_config = (t-1)*n_indz+z |
---|
| 270 | do mt = 0,meant |
---|
| 271 | do mz = 0,meanz |
---|
| 272 | number_local = mt*(meanz+1)+mz+1 |
---|
| 273 | number_global = (number_config-1)*(meant+1)*(meanz+1) + number_local |
---|
| 274 | if (first_reading) then |
---|
| 275 | print*,'First netcdf file reading...' |
---|
| 276 | first_reading = .false. |
---|
| 277 | end if |
---|
| 278 | |
---|
| 279 | !********** |
---|
| 280 | !Netcdf file reading |
---|
| 281 | ierror=-99999 |
---|
| 282 | i=0 |
---|
| 283 | ierror=nf90_inq_varid(idfile,trim(name_u),idzonal_wind) !try user named zonal wind |
---|
| 284 | do while (ierror /= 0 .and. i <= size(tab_name_u)-1) !try automatic named zonal wind |
---|
| 285 | i=i+1 |
---|
| 286 | ierror=nf90_inq_varid(idfile,trim(tab_name_u(i)),idzonal_wind) |
---|
| 287 | end do |
---|
| 288 | if (ierror == 0) then |
---|
| 289 | allocate(zonal_wind_lmdz(nlongp1,nlat)) |
---|
| 290 | if (name_alt == 'none') then |
---|
| 291 | if(name_time == 'none') then |
---|
| 292 | ierror=nf90_get_var(idfile,idzonal_wind,zonal_wind_lmdz,(/1,1/),(/nlongp1,nlat/)) |
---|
| 293 | else |
---|
| 294 | ierror=nf90_get_var(idfile,idzonal_wind,zonal_wind_lmdz,(/1,1,tab_indt((t-1)*(meant+1)+mt+1)/),(/nlongp1,nlat,1/)) |
---|
| 295 | end if |
---|
| 296 | end if |
---|
| 297 | if (name_alt /= 'none') then |
---|
| 298 | if(name_time == 'none') then |
---|
| 299 | ierror=nf90_get_var(idfile,idzonal_wind,zonal_wind_lmdz,(/1,1,tab_indz((z-1)*(meanz+1)+1)/),(/nlongp1,nlat,1/)) |
---|
| 300 | else |
---|
| 301 | ierror=nf90_get_var(idfile,idzonal_wind,zonal_wind_lmdz,& |
---|
| 302 | (/1,1,tab_indz((z-1)*(meanz+1)+1),tab_indt((t-1)*(meant+1)+mt+1)/),(/nlongp1,nlat,1,1/)) |
---|
| 303 | end if |
---|
| 304 | end if |
---|
| 305 | else |
---|
| 306 | print*,'zonal wind variable not found!' |
---|
[1404] | 307 | stop ' must have this... use ''-u zonalwindfieldname'' option.' |
---|
[1402] | 308 | end if |
---|
| 309 | |
---|
| 310 | ierror=-99999 |
---|
| 311 | i=0 |
---|
| 312 | ierror=nf90_inq_varid(idfile,trim(name_v),idmerid_wind) !try user named meridional wind |
---|
| 313 | do while (ierror /= 0 .and. i <= size(tab_name_v)-1) !try automatic named meridional wind |
---|
| 314 | i=i+1 |
---|
| 315 | ierror=nf90_inq_varid(idfile,trim(tab_name_v(i)),idmerid_wind) |
---|
| 316 | end do |
---|
| 317 | if (ierror == 0) then |
---|
| 318 | allocate(merid_wind_lmdz(nlongp1,nlat)) |
---|
| 319 | if (name_alt == 'none') then |
---|
| 320 | if(name_time == 'none') then |
---|
| 321 | ierror=nf90_get_var(idfile,idmerid_wind,merid_wind_lmdz,(/1,1/),(/nlongp1,nlat/)) |
---|
| 322 | else |
---|
| 323 | ierror=nf90_get_var(idfile,idmerid_wind,merid_wind_lmdz,(/1,1,tab_indt((t-1)*(meant+1)+mt+1)/),(/nlongp1,nlat,1/)) |
---|
| 324 | end if |
---|
| 325 | end if |
---|
| 326 | if (name_alt /= 'none') then |
---|
| 327 | if(name_time == 'none') then |
---|
| 328 | ierror=nf90_get_var(idfile,idmerid_wind,merid_wind_lmdz,(/1,1,tab_indz((z-1)*(meanz+1)+1)/),(/nlongp1,nlat,1/)) |
---|
| 329 | else |
---|
| 330 | ierror=nf90_get_var(idfile,idmerid_wind,merid_wind_lmdz,& |
---|
| 331 | (/1,1,tab_indz((z-1)*(meanz+1)+1),tab_indt((t-1)*(meant+1)+mt+1)/),(/nlongp1,nlat,1,1/)) |
---|
| 332 | end if |
---|
| 333 | end if |
---|
| 334 | else |
---|
| 335 | print*,'meridional wind variable not found!' |
---|
[1404] | 336 | stop ' must have this... use ''-v meridionalwindfieldname'' option.' |
---|
[1402] | 337 | end if |
---|
| 338 | |
---|
| 339 | !**********From lmdz to spherepack convention |
---|
| 340 | nlong=nlongp1-1 |
---|
| 341 | allocate(zonal_wind(nlat,nlong)) |
---|
| 342 | allocate(merid_wind(nlat,nlong)) |
---|
| 343 | zonal_wind(:,:)=transpose(zonal_wind_lmdz(1:nlong,:)) |
---|
| 344 | merid_wind(:,:)=transpose(merid_wind_lmdz(1:nlong,:)) |
---|
| 345 | !if (mod(nlat,2) == 0) then |
---|
| 346 | ! merid_wind(1:nlat/2,:)=-merid_wind(1:nlat/2,:) |
---|
| 347 | !else |
---|
| 348 | ! merid_wind(1:(nlat+1)/2,:)=-merid_wind(1:(nlat+1)/2,:) |
---|
| 349 | !end if |
---|
| 350 | |
---|
| 351 | !##### |
---|
| 352 | !Spectra computation |
---|
| 353 | !##### |
---|
| 354 | !**********Maximum value for m |
---|
| 355 | if (mod(nlong,2) == 0) then |
---|
| 356 | mmax = min(nlat,nlong/2) |
---|
| 357 | else |
---|
| 358 | mmax = min(nlat,(nlong+1)/2) |
---|
| 359 | end if |
---|
| 360 | |
---|
| 361 | !**********Vhaeci function (initialisations for Vhaec function) |
---|
| 362 | if (mod(nlong,2) == 0) then |
---|
| 363 | l1 = min(nlat,nlong/2) |
---|
| 364 | else |
---|
| 365 | l1 = min(nlat,(nlong+1)/2) |
---|
| 366 | end if |
---|
| 367 | if (mod(nlat,2) == 0) then |
---|
| 368 | l2 = nlat/2 |
---|
| 369 | else |
---|
| 370 | l2 = (nlat+1)/2 |
---|
| 371 | end if |
---|
| 372 | lvhaec=4*nlat*l2+3*max(l1-2,0)*(nlat+nlat-l1-1)+nlong+15 |
---|
| 373 | allocate(wvhaec(lvhaec)) |
---|
| 374 | wvhaec(:) = 0. |
---|
| 375 | ldwork=2*(nlat+2) |
---|
| 376 | allocate(dwork(ldwork)) |
---|
| 377 | dwork(:) = 0. |
---|
| 378 | ierror=3 |
---|
| 379 | call vhaeci(nlat,nlong,wvhaec,lvhaec,dwork,ldwork,ierror) |
---|
| 380 | |
---|
| 381 | !**********Vhaeci function result |
---|
| 382 | select case (ierror) |
---|
| 383 | case(1) |
---|
| 384 | print*,'Vhaeci: ERROR on nlat' |
---|
| 385 | case(2) |
---|
| 386 | print*,'Vhaeci: ERROR on nlong' |
---|
| 387 | case(3) |
---|
| 388 | print*,'Vhaeci: ERROR on lvhaec' |
---|
| 389 | case(4) |
---|
| 390 | print*,'Vhaeci: ERROR on ldwork' |
---|
| 391 | end select |
---|
| 392 | |
---|
| 393 | !**********Vhaec function (computes spectra coefficients) |
---|
| 394 | idvw=nlat |
---|
| 395 | jdvw=nlong |
---|
| 396 | mdab=mmax |
---|
| 397 | ndab=nlat |
---|
| 398 | allocate(br(mdab,ndab)) |
---|
| 399 | allocate(bi(mdab,ndab)) |
---|
| 400 | allocate(cr(mdab,ndab)) |
---|
| 401 | allocate(ci(mdab,ndab)) |
---|
| 402 | br(:,:) = 0. |
---|
| 403 | bi(:,:) = 0. |
---|
| 404 | cr(:,:) = 0. |
---|
| 405 | ci(:,:) = 0. |
---|
| 406 | if (mod(nlong,2) == 0) then |
---|
| 407 | l1 = min(nlat,nlong/2) |
---|
| 408 | else |
---|
| 409 | l1 = min(nlat,(nlong+1)/2) |
---|
| 410 | end if |
---|
| 411 | if (mod(nlat,2) == 0) then |
---|
| 412 | l2 = nlat/2 |
---|
| 413 | else |
---|
| 414 | l2 = (nlat+1)/2 |
---|
| 415 | end if |
---|
| 416 | lvhaec=4*nlat*l2+3*max(l1-2,0)*(nlat+nlat-l1-1)+nlong+15 |
---|
| 417 | if (ityp .le. 2) then |
---|
| 418 | lwork=nlat*(2*nt*nlong+max(6*l2,nlong)) |
---|
| 419 | else |
---|
| 420 | lwork=l2*(2*nt*nlong+max(6*nlat,nlong)) |
---|
| 421 | end if |
---|
| 422 | allocate(work(lwork)) |
---|
| 423 | work(:) = 0. |
---|
| 424 | ierror=3 |
---|
| 425 | call vhaec(nlat,nlong,ityp,nt,merid_wind,zonal_wind,idvw,jdvw,br,bi,cr,ci,mdab,ndab,wvhaec,lvhaec,work,lwork,ierror) |
---|
| 426 | |
---|
| 427 | !**********Vhaec function result |
---|
| 428 | select case (ierror) |
---|
| 429 | case(1) |
---|
| 430 | print*,'Vhaec: ERROR on nlat' |
---|
| 431 | case(2) |
---|
| 432 | print*,'Vhaec: ERROR on nlong' |
---|
| 433 | case(3) |
---|
| 434 | print*,'Vhaec: ERROR on ityp' |
---|
| 435 | case(4) |
---|
| 436 | print*,'Vhaec: ERROR on nt' |
---|
| 437 | case(5) |
---|
| 438 | print*,'Vhaec: ERROR on idvw' |
---|
| 439 | case(6) |
---|
| 440 | print*,'Vhaec: ERROR on jdvw' |
---|
| 441 | case(7) |
---|
| 442 | print*,'Vhaec: ERROR on mdab' |
---|
| 443 | case(8) |
---|
| 444 | print*,'Vhaec: ERROR on ndab' |
---|
| 445 | case(9) |
---|
| 446 | print*,'Vhaec: ERROR on lvhaec' |
---|
| 447 | case(10) |
---|
| 448 | print*,'Vhaec: ERROR on lwork' |
---|
| 449 | end select |
---|
| 450 | |
---|
| 451 | !**********Energy spectra |
---|
| 452 | allocate(norm(mMax,nLat)) |
---|
| 453 | allocate(norm_b(mMax,nLat)) |
---|
| 454 | allocate(norm_c(mMax,nLat)) |
---|
| 455 | do i = 1,mMax |
---|
| 456 | do j = 1,nLat |
---|
| 457 | norm(i,j)=(br(i,j)*br(i,j)+bi(i,j)*bi(i,j)+cr(i,j)*cr(i,j)+ci(i,j)*ci(i,j)) |
---|
| 458 | norm_b(i,j)=(br(i,j)*br(i,j)+bi(i,j)*bi(i,j)) |
---|
| 459 | norm_c(i,j)=(cr(i,j)*cr(i,j)+ci(i,j)*ci(i,j)) |
---|
| 460 | end do |
---|
| 461 | end do |
---|
| 462 | allocate(spectra(nLat)) |
---|
| 463 | allocate(spectra_b(nLat)) |
---|
| 464 | allocate(spectra_c(nLat)) |
---|
| 465 | do j = 1,nLat |
---|
| 466 | spectra(j) = 0.5*norm(1,j) |
---|
| 467 | spectra_b(j) = 0.5*norm_b(1,j) |
---|
| 468 | spectra_c(j) = 0.5*norm_c(1,j) |
---|
| 469 | do i = 2,mMax |
---|
| 470 | spectra(j) = spectra(j) + norm(i,j) |
---|
| 471 | spectra_b(j) = spectra_b(j) + norm_b(i,j) |
---|
| 472 | spectra_c(j) = spectra_c(j) + norm_c(i,j) |
---|
| 473 | end do |
---|
| 474 | end do |
---|
| 475 | !do j = 2,nLat |
---|
| 476 | ! spectra(j) = spectra(j)/((j-1)*j) |
---|
| 477 | ! spectra_b(j) = spectra_b(j)/((j-1)*j) |
---|
| 478 | ! spectra_c(j) = spectra_c(j)/((j-1)*j) |
---|
| 479 | !end do |
---|
| 480 | write(*,'(a16,i5,a3,i5,a1)') 'done spectra (t=',tab_indt((t-1)*(meant+1)+mt+1),',z=',tab_indz((z-1)*(meanz+1)+mz+1),')' |
---|
| 481 | |
---|
| 482 | !**********Storage of all spectra |
---|
| 483 | spectra_global(:,number_global) = spectra(:) |
---|
| 484 | spectra_b_global(:,number_global) = spectra_b(:) |
---|
| 485 | spectra_c_global(:,number_global) = spectra_c(:) |
---|
| 486 | |
---|
[1426] | 487 | !**********Some cleaning |
---|
| 488 | deallocate(br) |
---|
| 489 | deallocate(bi) |
---|
| 490 | deallocate(cr) |
---|
| 491 | deallocate(ci) |
---|
| 492 | deallocate(wvhaec) |
---|
| 493 | deallocate(dwork) |
---|
| 494 | deallocate(work) |
---|
| 495 | deallocate(norm) |
---|
| 496 | deallocate(norm_b) |
---|
| 497 | deallocate(norm_c) |
---|
| 498 | deallocate(spectra) |
---|
| 499 | deallocate(spectra_b) |
---|
| 500 | deallocate(spectra_c) |
---|
| 501 | deallocate(zonal_wind) |
---|
| 502 | deallocate(merid_wind) |
---|
| 503 | deallocate(zonal_wind_lmdz) |
---|
| 504 | deallocate(merid_wind_lmdz) |
---|
| 505 | |
---|
[1402] | 506 | !********** |
---|
| 507 | !End of loop over time and altitude indices |
---|
| 508 | end do |
---|
| 509 | end do |
---|
| 510 | write(*,'(a24,i5,a3,i5,a8)') 'spectra computed for (t=',tab_indt((t-1)*(meant+1)+1),',z=',tab_indz((z-1)*(meanz+1)+1),') config' |
---|
| 511 | write(*,*) '**********' |
---|
| 512 | end do |
---|
| 513 | end do |
---|
| 514 | |
---|
| 515 | !********** |
---|
| 516 | !Spectra mean |
---|
| 517 | do t = 1,n_indt |
---|
| 518 | do z = 1,n_indz |
---|
| 519 | number_config = (t-1)*n_indz+z |
---|
| 520 | spectra_config(:,number_config) = 0. |
---|
| 521 | do mt = 0,meant |
---|
| 522 | do mz = 0,meanz |
---|
| 523 | number_local = mt*(meanz+1)+mz+1 |
---|
| 524 | number_global = (number_config-1)*(meant+1)*(meanz+1) + number_local |
---|
| 525 | spectra_config(:,number_config) = spectra_config(:,number_config) + & |
---|
| 526 | spectra_global(:,number_global) |
---|
| 527 | spectra_b_config(:,number_config) = spectra_b_config(:,number_config) + & |
---|
| 528 | spectra_b_global(:,number_global) |
---|
| 529 | spectra_c_config(:,number_config) = spectra_c_config(:,number_config) + & |
---|
| 530 | spectra_c_global(:,number_global) |
---|
| 531 | end do |
---|
| 532 | end do |
---|
| 533 | spectra_config(:,number_config) = spectra_config(:,number_config)/(meanz+1)/(meant+1) |
---|
| 534 | spectra_b_config(:,number_config) = spectra_b_config(:,number_config)/(meanz+1)/(meant+1) |
---|
| 535 | spectra_c_config(:,number_config) = spectra_c_config(:,number_config)/(meanz+1)/(meant+1) |
---|
| 536 | end do |
---|
| 537 | end do |
---|
| 538 | |
---|
| 539 | !**********Writing header of file_spectra |
---|
| 540 | open(unit=10,file=file_spectra,action="write",position="rewind") |
---|
| 541 | write(10,'(a10,a2)',advance='no') '#Spherical',' ' |
---|
| 542 | do t = 1,n_indt |
---|
| 543 | do z = 1,n_indz |
---|
| 544 | write(10,'(a50)',advance='no') file_netcdf |
---|
| 545 | end do |
---|
| 546 | end do |
---|
[1426] | 547 | write(10,*) |
---|
[1402] | 548 | write(10,'(a11,a1)',advance='no') '#wavenumber',' ' |
---|
| 549 | do t = 1,n_indt |
---|
| 550 | do z = 1,n_indz |
---|
| 551 | write(10,'(a2,i5,a3,i5,a35)',advance='no') 't=',tab_indt((t-1)*(meant+1)+1),' z=',tab_indz((z-1)*(meanz+1)+1),' ' |
---|
| 552 | end do |
---|
| 553 | end do |
---|
[1426] | 554 | write(10,*) |
---|
[1402] | 555 | write(10,'(a1,a11)',advance='no') '#',' ' |
---|
| 556 | do t = 1,n_indt |
---|
| 557 | do z = 1,n_indz |
---|
| 558 | if (is_div_rot) then |
---|
| 559 | write(10,'(a8,a8,a8,a8,a8,a10)',advance='no') 'spec_tot',' ','spec_div',' ','spec_rot',' ' |
---|
| 560 | else |
---|
| 561 | write(10,'(a8,a42)',advance='no') 'spec_tot',' ' |
---|
| 562 | end if |
---|
| 563 | end do |
---|
| 564 | end do |
---|
[1426] | 565 | write(10,*) |
---|
[1402] | 566 | !**********Writing file_spectra |
---|
| 567 | do j=1,nLat |
---|
[1426] | 568 | write(10,'(i5,a6)',advance='no') j-1,' ' |
---|
[1402] | 569 | do t = 1,n_indt |
---|
| 570 | do z = 1,n_indz |
---|
| 571 | number_config = (t-1)*n_indz+z |
---|
| 572 | if (is_div_rot) then |
---|
[1426] | 573 | write(10,'(e13.6E2,a3,e13.6E2,a3,e13.6E2,a5)',advance='no') spectra_config(j,number_config),' ',& |
---|
[1402] | 574 | spectra_b_config(j,number_config),' ',spectra_c_config(j,number_config),' ' |
---|
| 575 | else |
---|
[1426] | 576 | write(10,'(e13.6E2,a37)',advance='no') spectra_config(j,number_config),' ' |
---|
[1402] | 577 | end if |
---|
| 578 | end do |
---|
| 579 | end do |
---|
[1426] | 580 | if (j /= nlat) write(10,*) |
---|
[1402] | 581 | end do |
---|
| 582 | close(10) |
---|
| 583 | |
---|
| 584 | print *, "***SUCCESS writing ",trim(file_spectra) |
---|
| 585 | |
---|
[1426] | 586 | !***********Some cleaning |
---|
| 587 | deallocate(spectra_config) |
---|
| 588 | deallocate(spectra_b_config) |
---|
| 589 | deallocate(spectra_c_config) |
---|
| 590 | deallocate(spectra_global) |
---|
| 591 | deallocate(spectra_b_global) |
---|
| 592 | deallocate(spectra_c_global) |
---|
| 593 | deallocate(tab_indt) |
---|
| 594 | deallocate(tab_indz) |
---|
| 595 | deallocate(tmp_tab_int) |
---|
| 596 | deallocate(arg) |
---|
| 597 | |
---|
[1402] | 598 | contains |
---|
| 599 | subroutine check(status) |
---|
| 600 | integer, intent (in) :: status |
---|
| 601 | |
---|
| 602 | if(status /= nf90_noerr) then |
---|
| 603 | print *, trim(nf90_strerror(status)) |
---|
| 604 | stop "Stopped" |
---|
| 605 | end if |
---|
| 606 | end subroutine check |
---|
| 607 | |
---|
| 608 | END PROGRAM spectra_analysis |
---|