[137] | 1 | program localtime |
---|
| 2 | |
---|
| 3 | ! ---------------------------------------------------------------------------- |
---|
| 4 | ! Program to redistribute and interpolate the variable a the same |
---|
| 5 | ! local times everywhere |
---|
| 6 | ! input : diagfi.nc / concat.nc / stats.nc kind of files |
---|
| 7 | ! author: F. Forget |
---|
| 8 | ! ---------------------------------------------------------------------------- |
---|
| 9 | |
---|
| 10 | implicit none |
---|
| 11 | |
---|
| 12 | include "netcdf.inc" ! NetCDF definitions |
---|
| 13 | |
---|
[2567] | 14 | character (len=100) file |
---|
[137] | 15 | ! file(): input file(s) names(s) |
---|
[2434] | 16 | character (len=30), dimension(16) :: notprocessed |
---|
| 17 | ! notprocessed(): names of the (16) variables that won't be processed |
---|
[2567] | 18 | character (len=100), dimension(:), allocatable :: var |
---|
[2434] | 19 | ! var(): name(s) of variable(s) that will be processed |
---|
| 20 | character (len=100) :: tmpvar,long_name,units |
---|
[137] | 21 | ! tmpvar(): used to temporarily store a variable name |
---|
[2434] | 22 | ! long_name(): [netcdf] long_name attribute |
---|
[137] | 23 | ! units(): [netcdf] units attribute |
---|
| 24 | character (len=100) :: filename,vartmp |
---|
| 25 | ! filename(): output file name |
---|
| 26 | ! vartmp(): temporary variable name (read from netcdf input file) |
---|
| 27 | !character (len=1) :: ccopy |
---|
| 28 | ! ccpy: 'y' or 'n' answer |
---|
[2227] | 29 | |
---|
| 30 | character (len=50) :: altlong_name,altunits,altpositive |
---|
| 31 | ! altlong_name(): [netcdf] altitude "long_name" attribute |
---|
| 32 | ! altunits(): [netcdf] altitude "units" attribute |
---|
| 33 | ! altpositive(): [netcdf] altitude "positive" attribute |
---|
| 34 | |
---|
| 35 | integer :: nid,ierr,miss,validr |
---|
[137] | 36 | ! nid: [netcdf] file ID # |
---|
| 37 | ! ierr: [netcdf] subroutine returned error code |
---|
| 38 | ! miss: [netcdf] subroutine returned error code |
---|
| 39 | integer :: i,j,k,inter |
---|
| 40 | ! for various loops |
---|
| 41 | integer :: varid |
---|
| 42 | ! varid: [netcdf] variable ID # |
---|
[1073] | 43 | real, dimension(:), allocatable:: lat,lon,alt,ctl,time |
---|
[137] | 44 | ! lat(): array, stores latitude coordinates |
---|
| 45 | ! lon(): array, stores longitude coordinates |
---|
| 46 | ! alt(): array, stores altitude coordinates |
---|
[1073] | 47 | ! ctl(): array, stores controle array |
---|
[137] | 48 | ! time(): array, stores time coordinates |
---|
| 49 | integer :: nbvar,nbvarfile,ndim |
---|
| 50 | ! nbvar: # of variables to concatenate |
---|
| 51 | ! nbfile: # number of input file(s) |
---|
| 52 | ! nbvarfile: total # of variables in an input file |
---|
| 53 | ! ndim: [netcdf] # (3 or 4) of dimensions (for variables) |
---|
[1073] | 54 | integer :: latdim,londim,altdim,ctldim,timedim |
---|
[137] | 55 | ! latdim: [netcdf] "latitude" dim ID |
---|
| 56 | ! londim: [netcdf] "longitude" dim ID |
---|
| 57 | ! altdim: [netcdf] "altdim" dim ID |
---|
[1073] | 58 | ! ctldim: [netcdf] "controle" dim ID |
---|
[137] | 59 | ! timedim: [netcdf] "timedim" dim ID |
---|
[2434] | 60 | integer :: gcmlayerdim ! NetCDF dimension ID for # of layers in GCM |
---|
[1073] | 61 | integer :: latvar,lonvar,altvar,ctlvar,timevar |
---|
[137] | 62 | ! latvar: [netcdf] ID of "latitude" variable |
---|
| 63 | ! lonvar: [netcdf] ID of "longitude" variable |
---|
| 64 | ! altvar: [netcdf] ID of "altitude" variable |
---|
[1073] | 65 | ! ctlvar: [netcdf] ID of "controle" variable |
---|
[137] | 66 | ! timevar: [netcdf] ID of "Time" variable |
---|
[1073] | 67 | integer :: latlen,lonlen,altlen,ctllen,timelen,timelen_lt,timelen_tot |
---|
[137] | 68 | integer :: ilat,ilon,ialt,it |
---|
| 69 | ! latlen: # of elements of lat() array |
---|
| 70 | ! lonlen: # of elements of lon() array |
---|
[2434] | 71 | ! altlen: # of elements of alt() array |
---|
| 72 | ! ctllen: # of elements of ctl() array |
---|
[137] | 73 | ! timelen: # of elemnets of time() array |
---|
| 74 | ! timelen_tot:# =timelen or timelen+1 (if 1 more time to interpolate needed) |
---|
| 75 | ! timelen_lt: # of elemnets of time() array in output |
---|
[2434] | 76 | integer :: nhour,nsol |
---|
| 77 | integer :: GCM_layers ! number of GCM atmospheric layers (may not be |
---|
| 78 | ! same as altlen if file is an output of zrecast) |
---|
[137] | 79 | integer :: nout,latdimout,londimout,altdimout,timedimout,timevarout |
---|
| 80 | ! nout: [netcdf] output file ID |
---|
| 81 | ! latdimout: [netcdf] output latitude (dimension) ID |
---|
| 82 | ! londimout: [netcdf] output longitude (dimension) ID |
---|
| 83 | ! altdimout: [netcdf] output altitude (dimension) ID |
---|
| 84 | ! timedimout: [netcdf] output time (dimension) ID |
---|
| 85 | ! timevarout: [netcdf] ID of output "Time" variable |
---|
[2434] | 86 | integer :: layerdimout ! NetCDF dimension ID for # of layers in GCM |
---|
[137] | 87 | integer :: varidout |
---|
| 88 | ! varidout: [netcdf] variable ID # (of a variable to write to the output file) |
---|
[2434] | 89 | integer :: Nnotprocessed,var_ok |
---|
| 90 | ! Nnotprocessed: # of (leading)variables that won't be concatenated |
---|
[137] | 91 | ! var_ok: flag (0 or 1) |
---|
| 92 | integer, dimension(4) :: corner,edges,dim |
---|
| 93 | ! corner: [netcdf] |
---|
| 94 | ! edges: [netcdf] |
---|
| 95 | ! dim: [netcdf] |
---|
| 96 | real, dimension(:,:,:,:), allocatable :: var3d |
---|
| 97 | ! var3D(,,,): 4D array to store a field |
---|
| 98 | |
---|
| 99 | real, dimension(:,:,:,:), allocatable :: var3d_lt |
---|
| 100 | ! var3D_lt(,,,): 4D array to store a field in local time coordinate |
---|
| 101 | real, dimension(:), allocatable :: lt_gcm,lt_hour |
---|
| 102 | real, dimension(:), allocatable :: lt_out,lt_outc |
---|
| 103 | real, dimension(:), allocatable :: var_gcm |
---|
| 104 | |
---|
| 105 | real :: missing |
---|
| 106 | !PARAMETER(missing=1E+20) |
---|
| 107 | ! missing: [netcdf] to handle "missing" values when reading/writing files |
---|
| 108 | real, dimension(2) :: valid_range |
---|
| 109 | ! valid_range(2): [netcdf] interval in which a value is considered valid |
---|
| 110 | logical :: stats ! stats=T when reading a "stats" kind of ile |
---|
| 111 | |
---|
| 112 | |
---|
| 113 | !============================================================================== |
---|
| 114 | ! 1.1. Get input file name(s) |
---|
| 115 | !============================================================================== |
---|
| 116 | write(*,*) |
---|
| 117 | write(*,*) "which file do you want to use? (diagfi... stats... concat...)" |
---|
| 118 | |
---|
| 119 | read(*,'(a50)') file |
---|
| 120 | |
---|
| 121 | if (len_trim(file).eq.0) then |
---|
| 122 | write(*,*) "no file... game over" |
---|
[2567] | 123 | stop |
---|
[137] | 124 | endif |
---|
| 125 | |
---|
| 126 | !============================================================================== |
---|
[2204] | 127 | ! 1.3. Open the input file |
---|
[137] | 128 | !============================================================================== |
---|
| 129 | |
---|
| 130 | ierr = NF_OPEN(file,NF_NOWRITE,nid) |
---|
| 131 | if (ierr.NE.NF_NOERR) then |
---|
[2204] | 132 | write(*,*) 'ERROR: Pb opening file '//trim(file) |
---|
| 133 | write(*,*) NF_STRERROR(ierr) |
---|
[2567] | 134 | stop |
---|
[137] | 135 | endif |
---|
| 136 | |
---|
| 137 | ierr=NF_INQ_NVARS(nid,nbvarfile) |
---|
| 138 | ! nbvarfile now set to be the (total) number of variables in file |
---|
[2204] | 139 | if (ierr.NE.NF_NOERR) then |
---|
| 140 | write(*,*) 'ERROR: Pb with NF_INQ_NVARS' |
---|
| 141 | write(*,*) NF_STRERROR(ierr) |
---|
[2567] | 142 | stop |
---|
[2204] | 143 | endif |
---|
[137] | 144 | |
---|
| 145 | !============================================================================== |
---|
[2204] | 146 | ! 1.4. List of variables that should not be processed |
---|
[137] | 147 | !============================================================================== |
---|
| 148 | |
---|
[2434] | 149 | notprocessed(1)='Time' |
---|
| 150 | notprocessed(2)='controle' |
---|
| 151 | notprocessed(3)='rlonu' |
---|
| 152 | notprocessed(4)='latitude' |
---|
| 153 | notprocessed(5)='longitude' |
---|
| 154 | notprocessed(6)='altitude' |
---|
| 155 | notprocessed(7)='rlatv' |
---|
| 156 | notprocessed(8)='aps' |
---|
| 157 | notprocessed(9)='bps' |
---|
| 158 | notprocessed(10)='ap' |
---|
| 159 | notprocessed(11)='bp' |
---|
| 160 | notprocessed(12)='soildepth' |
---|
| 161 | notprocessed(13)='cu' |
---|
| 162 | notprocessed(14)='cv' |
---|
| 163 | notprocessed(15)='aire' |
---|
| 164 | notprocessed(16)='phisinit' |
---|
[137] | 165 | |
---|
[2434] | 166 | |
---|
[137] | 167 | !============================================================================== |
---|
[2204] | 168 | ! 1.5. Get (and check) list of variables to process |
---|
[137] | 169 | !============================================================================== |
---|
| 170 | write(*,*) |
---|
[2434] | 171 | Nnotprocessed=0 |
---|
[137] | 172 | do i=1,nbvarfile |
---|
| 173 | ierr=NF_INQ_VARNAME(nid,i,vartmp) |
---|
| 174 | ! vartmp now contains the "name" of variable of ID # i |
---|
| 175 | var_ok=0 |
---|
[2434] | 176 | do inter=1,16 |
---|
| 177 | if (vartmp.eq.notprocessed(inter)) then |
---|
[137] | 178 | var_ok=1 |
---|
[2434] | 179 | Nnotprocessed=Nnotprocessed+1 |
---|
[137] | 180 | endif |
---|
| 181 | enddo |
---|
| 182 | if (var_ok.eq.0) write(*,*) trim(vartmp) |
---|
| 183 | enddo |
---|
| 184 | |
---|
[2434] | 185 | ! Nnotprocessed: # of variables that won't be processed |
---|
[137] | 186 | ! nbvarfile: total # of variables in file |
---|
[2434] | 187 | allocate(var(nbvarfile-Nnotprocessed),stat=ierr) |
---|
[2204] | 188 | if (ierr.ne.0) then |
---|
[2434] | 189 | write(*,*) "Error: failed allocation of var(nbvarfile-Nnotprocessed)" |
---|
[2204] | 190 | write(*,*) " nbvarfile=",nbvarfile |
---|
[2434] | 191 | write(*,*) " Nnotprocessed=",Nnotprocessed |
---|
[2204] | 192 | stop |
---|
| 193 | endif |
---|
[137] | 194 | |
---|
| 195 | |
---|
| 196 | write(*,*) |
---|
| 197 | write(*,*) "which variables do you want to redistribute ?" |
---|
| 198 | write(*,*) "all / list of <variables> (separated by <Enter>s)" |
---|
| 199 | write(*,*) "(an empty line , i.e: just <Enter>, implies end of list)" |
---|
| 200 | nbvar=0 |
---|
[2567] | 201 | read(*,'(a100)') tmpvar |
---|
[137] | 202 | do while ((tmpvar/=' ').AND.(trim(tmpvar)/='all')) |
---|
| 203 | nbvar=nbvar+1 |
---|
| 204 | var(nbvar)=tmpvar |
---|
[2567] | 205 | read(*,'(a100)') tmpvar |
---|
[137] | 206 | enddo |
---|
| 207 | |
---|
| 208 | if (tmpvar=="all") then |
---|
[2434] | 209 | nbvar=nbvarfile-Nnotprocessed |
---|
| 210 | do j=Nnotprocessed+1,nbvarfile |
---|
| 211 | ierr=nf_inq_varname(nid,j,var(j-Nnotprocessed)) |
---|
[137] | 212 | enddo |
---|
[2204] | 213 | ! Variables names from the file are stored in var() |
---|
[2434] | 214 | nbvar=nbvarfile-Nnotprocessed |
---|
[137] | 215 | do i=1,nbvar |
---|
[2434] | 216 | ierr=nf_inq_varname(nid,i+Nnotprocessed,var(i)) |
---|
[137] | 217 | write(*,'(a9,1x,i2,1x,a1,1x,a50)') "variable ",i,":",var(i) |
---|
| 218 | enddo |
---|
| 219 | else if(nbvar==0) then |
---|
| 220 | write(*,*) "no variable... game over" |
---|
[2567] | 221 | stop |
---|
[137] | 222 | endif ! of if (tmpvar=="all") |
---|
| 223 | |
---|
| 224 | !============================================================================== |
---|
| 225 | ! 1.6. Get output file name |
---|
| 226 | !============================================================================== |
---|
| 227 | filename=file(1:len_trim(file)-3)//"_LT.nc" |
---|
[2434] | 228 | write(*,*) "Output file :"//trim(filename) |
---|
[137] | 229 | |
---|
| 230 | !============================================================================== |
---|
| 231 | ! 2.1. Open input file |
---|
| 232 | !============================================================================== |
---|
| 233 | |
---|
[2434] | 234 | write(*,*) |
---|
| 235 | write(*,*) "opening "//trim(file)//"..." |
---|
| 236 | ierr = NF_OPEN(file,NF_NOWRITE,nid) |
---|
| 237 | if (ierr.NE.NF_NOERR) then |
---|
| 238 | write(*,*) 'ERROR: Pb opening file '//trim(file) |
---|
| 239 | write(*,*) NF_STRERROR(ierr) |
---|
[2567] | 240 | stop |
---|
[2434] | 241 | endif |
---|
[137] | 242 | |
---|
| 243 | !============================================================================== |
---|
| 244 | ! 2.2. Read (and check) dimensions of variables from input file |
---|
| 245 | !============================================================================== |
---|
| 246 | |
---|
| 247 | ierr=NF_INQ_DIMID(nid,"latitude",latdim) |
---|
[2204] | 248 | if (ierr.NE.NF_NOERR) then |
---|
[2546] | 249 | write(*,*) 'Dimension <latitude> is missing, looking for lat' |
---|
| 250 | ierr=NF_INQ_DIMID(nid,"lat",latdim) |
---|
| 251 | if (ierr.NE.NF_NOERR) then |
---|
| 252 | write(*,*) 'ERROR: Dimension <latitude> and <lat> is missing in file '//trim(file) |
---|
[2567] | 253 | stop |
---|
[2546] | 254 | endif |
---|
[2204] | 255 | endif |
---|
[137] | 256 | ierr=NF_INQ_VARID(nid,"latitude",latvar) |
---|
| 257 | if (ierr.NE.NF_NOERR) then |
---|
[2546] | 258 | write(*,*) 'Field <latitude> is missing, looking for lat' |
---|
| 259 | ierr=NF_INQ_VARID(nid,"lat",latvar) |
---|
| 260 | if (ierr.NE.NF_NOERR) then |
---|
| 261 | write(*,*) 'ERROR: Field <latitude> and <lat> is missing in file '//trim(file) |
---|
[2567] | 262 | stop |
---|
[2546] | 263 | endif |
---|
[137] | 264 | endif |
---|
| 265 | ierr=NF_INQ_DIMLEN(nid,latdim,latlen) |
---|
| 266 | ! write(*,*) "latlen: ",latlen |
---|
| 267 | |
---|
| 268 | ierr=NF_INQ_DIMID(nid,"longitude",londim) |
---|
[2204] | 269 | if (ierr.NE.NF_NOERR) then |
---|
[2546] | 270 | write(*,*) 'Field <longitude> is missing, looking for lon' |
---|
| 271 | ierr=NF_INQ_DIMID(nid,"lon",londim) |
---|
| 272 | if (ierr.NE.NF_NOERR) then |
---|
| 273 | write(*,*) 'ERROR: Dimension <longitude> and <lon> is missing in file '//trim(file) |
---|
[2567] | 274 | stop |
---|
[2546] | 275 | endif |
---|
[2204] | 276 | endif |
---|
[137] | 277 | ierr=NF_INQ_VARID(nid,"longitude",lonvar) |
---|
| 278 | if (ierr.NE.NF_NOERR) then |
---|
[2546] | 279 | write(*,*) 'Field <longitude> is missing, looking for lon' |
---|
| 280 | ierr=NF_INQ_VARID(nid,"lon",lonvar) |
---|
| 281 | if (ierr.NE.NF_NOERR) then |
---|
| 282 | write(*,*) 'ERROR: Field <longitude> and <lon> is missing in file '//trim(file) |
---|
[2567] | 283 | stop |
---|
[2546] | 284 | endif |
---|
[137] | 285 | endif |
---|
| 286 | ierr=NF_INQ_DIMLEN(nid,londim,lonlen) |
---|
| 287 | ! write(*,*) "lonlen: ",lonlen |
---|
| 288 | |
---|
| 289 | ierr=NF_INQ_DIMID(nid,"altitude",altdim) |
---|
[2204] | 290 | if (ierr.NE.NF_NOERR) then |
---|
| 291 | write(*,*) 'ERROR: Dimension <altitude> is missing in file '//trim(file) |
---|
[2567] | 292 | stop |
---|
[2204] | 293 | endif |
---|
[137] | 294 | ierr=NF_INQ_VARID(nid,"altitude",altvar) |
---|
| 295 | if (ierr.NE.NF_NOERR) then |
---|
[2280] | 296 | write(*,*) 'ERROR: Field <altitude> is missing in file '//trim(file) |
---|
[2567] | 297 | stop |
---|
[137] | 298 | endif |
---|
| 299 | ierr=NF_INQ_DIMLEN(nid,altdim,altlen) |
---|
| 300 | ! write(*,*) "altlen: ",altlen |
---|
| 301 | |
---|
[2434] | 302 | ! load size of aps() or sigma() (in case it is not altlen) |
---|
| 303 | ! default is that GCM_layers=altlen |
---|
| 304 | ! but for outputs of zrecast, it may be a different value |
---|
| 305 | ierr=NF_INQ_DIMID(nid,"GCM_layers",gcmlayerdim) |
---|
| 306 | if (ierr.ne.NF_NOERR) then |
---|
| 307 | ! didn't find a GCM_layers dimension; therefore we have: |
---|
| 308 | GCM_layers=altlen |
---|
| 309 | else |
---|
| 310 | ! load value of GCM_layers |
---|
| 311 | ierr=NF_INQ_DIMLEN(nid,gcmlayerdim,GCM_layers) |
---|
| 312 | endif |
---|
| 313 | ! write(*,*) "GCM_layers=",GCM_layers |
---|
| 314 | |
---|
[1073] | 315 | ierr=NF_INQ_DIMID(nid,"index",ctldim) |
---|
[2204] | 316 | if (ierr.NE.NF_NOERR) then |
---|
[2280] | 317 | write(*,*) 'Dimension <index> is missing in file '//trim(file) |
---|
[2546] | 318 | write(*,*) 'Looking for controle_axe' |
---|
| 319 | ierr=NF_INQ_DIMID(nid,"controle_axe",ctldim) |
---|
| 320 | if (ierr.NE.NF_NOERR) then |
---|
| 321 | ctllen=0 |
---|
| 322 | endif |
---|
[2567] | 323 | !stop |
---|
[2204] | 324 | endif |
---|
[2546] | 325 | ! ierr=NF_INQ_DIMID(nid,"controle_axe",ctldim) |
---|
| 326 | ! if (ierr.NE.NF_NOERR) then |
---|
[2567] | 327 | ! !stop |
---|
[2546] | 328 | ! endif |
---|
[1073] | 329 | ierr=NF_INQ_VARID(nid,"controle",ctlvar) |
---|
| 330 | if (ierr.NE.NF_NOERR) then |
---|
[2280] | 331 | write(*,*) 'Field <controle> is missing in file '//trim(file) |
---|
[1073] | 332 | ctllen=0 |
---|
[2567] | 333 | !stop |
---|
[1073] | 334 | else |
---|
| 335 | ierr=NF_INQ_DIMLEN(nid,ctldim,ctllen) |
---|
| 336 | endif |
---|
| 337 | ! write(*,*) "controle: ",controle |
---|
| 338 | |
---|
[137] | 339 | !============================================================================== |
---|
| 340 | ! 2.3. Read (and check compatibility of) dimensions of |
---|
| 341 | ! variables from input file |
---|
| 342 | !============================================================================== |
---|
| 343 | |
---|
[2434] | 344 | allocate(lat(latlen),stat=ierr) |
---|
| 345 | if (ierr.ne.0) then |
---|
| 346 | write(*,*) "Error: failed to allocate lat(latlen)" |
---|
| 347 | stop |
---|
| 348 | endif |
---|
| 349 | allocate(lon(lonlen),stat=ierr) |
---|
| 350 | if (ierr.ne.0) then |
---|
| 351 | write(*,*) "Error: failed to allocate lon(lonlen)" |
---|
| 352 | stop |
---|
| 353 | endif |
---|
| 354 | allocate(alt(altlen),stat=ierr) |
---|
| 355 | if (ierr.ne.0) then |
---|
| 356 | write(*,*) "Error: failed to allocate alt(altlen)" |
---|
| 357 | stop |
---|
| 358 | endif |
---|
| 359 | allocate(ctl(ctllen),stat=ierr) |
---|
| 360 | if (ierr.ne.0) then |
---|
| 361 | write(*,*) "Error: failed to allocate ctl(ctllen)" |
---|
| 362 | stop |
---|
| 363 | endif |
---|
[2204] | 364 | |
---|
[2434] | 365 | ierr = NF_GET_VAR_REAL(nid,latvar,lat) |
---|
| 366 | if (ierr.ne.0) then |
---|
| 367 | write(*,*) "Error: failed to load latitude" |
---|
| 368 | write(*,*) NF_STRERROR(ierr) |
---|
| 369 | stop |
---|
| 370 | endif |
---|
[2204] | 371 | |
---|
[2434] | 372 | ierr = NF_GET_VAR_REAL(nid,lonvar,lon) |
---|
| 373 | if (ierr.ne.0) then |
---|
| 374 | write(*,*) "Error: failed to load longitude" |
---|
| 375 | write(*,*) NF_STRERROR(ierr) |
---|
| 376 | stop |
---|
| 377 | endif |
---|
[2204] | 378 | |
---|
[2434] | 379 | ierr = NF_GET_VAR_REAL(nid,altvar,alt) |
---|
| 380 | if (ierr.ne.0) then |
---|
| 381 | write(*,*) "Error: failed to load altitude" |
---|
| 382 | write(*,*) NF_STRERROR(ierr) |
---|
| 383 | stop |
---|
| 384 | endif |
---|
[2227] | 385 | ! Get altitude attributes to handle files with any altitude type |
---|
[2434] | 386 | ierr=nf_get_att_text(nid,altvar,'long_name',altlong_name) |
---|
| 387 | if (ierr.ne.nf_noerr) then |
---|
| 388 | ! if no attribute "long_name", try "title" |
---|
| 389 | ierr=nf_get_att_text(nid,timevar,"title",long_name) |
---|
| 390 | endif |
---|
| 391 | ierr=nf_get_att_text(nid,altvar,'units',altunits) |
---|
| 392 | ierr=nf_get_att_text(nid,altvar,'positive',altpositive) |
---|
[2204] | 393 | |
---|
[2434] | 394 | if (ctllen .ne. 0) then |
---|
| 395 | ierr = NF_GET_VAR_REAL(nid,ctlvar,ctl) |
---|
| 396 | if (ierr.ne.0) then |
---|
| 397 | write(*,*) "Error: failed to load controle" |
---|
| 398 | write(*,*) NF_STRERROR(ierr) |
---|
| 399 | stop |
---|
| 400 | endif |
---|
| 401 | endif ! of if (ctllen .ne. 0) |
---|
[2204] | 402 | |
---|
[137] | 403 | !============================================================================== |
---|
| 404 | ! 2.4. Handle "Time" dimension from input file |
---|
| 405 | !============================================================================== |
---|
| 406 | |
---|
| 407 | !============================================================================== |
---|
| 408 | ! 2.4.0 Read "Time" dimension from input file |
---|
| 409 | !============================================================================== |
---|
| 410 | ierr=NF_INQ_DIMID(nid,"Time",timedim) |
---|
| 411 | if (ierr.NE.NF_NOERR) then |
---|
[2546] | 412 | write(*,*) 'ERROR: Dimension <Time> is missing looking for time_counter' |
---|
| 413 | ierr=NF_INQ_DIMID(nid,"time_counter",timedim) |
---|
| 414 | if (ierr.NE.NF_NOERR) then |
---|
| 415 | write(*,*) 'ERROR: Dimension <Time> or is missing in file'//trim(file) |
---|
[2567] | 416 | stop |
---|
[2546] | 417 | endif |
---|
[137] | 418 | endif |
---|
| 419 | ierr=NF_INQ_VARID(nid,"Time",timevar) |
---|
| 420 | if (ierr.NE.NF_NOERR) then |
---|
[2546] | 421 | write(*,*) 'ERROR: Field <Time> is missing looking for time_counter' |
---|
| 422 | ierr=NF_INQ_VARID(nid,"time_counter",timevar) |
---|
| 423 | if (ierr.NE.NF_NOERR) then |
---|
| 424 | write(*,*) 'ERROR: Field <Time> is missing in file '//trim(file) |
---|
[2567] | 425 | stop |
---|
[2546] | 426 | endif |
---|
[137] | 427 | endif |
---|
| 428 | ierr=NF_INQ_DIMLEN(nid,timedim,timelen) |
---|
| 429 | ! write(*,*) "timelen: ",timelen |
---|
| 430 | |
---|
[2434] | 431 | ! Sanity Check: Does "Time" has a "long_name" attribute |
---|
[2147] | 432 | ! and is it "Solar longitude" ? |
---|
[2434] | 433 | ierr=nf_get_att_text(nid,timevar,"long_name",long_name) |
---|
| 434 | if (ierr.ne.nf_noerr) then |
---|
| 435 | ! if no attribute "long_name", try "title" |
---|
| 436 | ierr=nf_get_att_text(nid,timevar,"title",long_name) |
---|
| 437 | endif |
---|
[2440] | 438 | if ((ierr.EQ.NF_NOERR).and.(index(long_name,"Solar").ne.0)) then |
---|
| 439 | ! if long_name contains "Solar" |
---|
[2147] | 440 | write(*,*) "ERROR: Time axis in input file is in Solar Longitude!" |
---|
| 441 | write(*,*) " localtime requires sols as time axis!" |
---|
| 442 | write(*,*) " Might as well stop here." |
---|
| 443 | stop |
---|
| 444 | endif |
---|
| 445 | |
---|
[137] | 446 | ! allocate time() array and fill it with values from input file |
---|
[2204] | 447 | allocate(time(timelen),stat=ierr) |
---|
| 448 | if (ierr.ne.0) then |
---|
| 449 | write(*,*) "Error: failed to allocate time(timelen)" |
---|
| 450 | stop |
---|
| 451 | endif |
---|
[137] | 452 | |
---|
| 453 | ierr = NF_GET_VAR_REAL(nid,timevar,time) |
---|
[2147] | 454 | if (ierr.NE.NF_NOERR) then |
---|
| 455 | write(*,*) "Error , failed to load Time" |
---|
[2204] | 456 | write(*,*) NF_STRERROR(ierr) |
---|
[2147] | 457 | stop |
---|
| 458 | endif |
---|
[137] | 459 | |
---|
| 460 | |
---|
| 461 | !============================================================================== |
---|
| 462 | ! 2.4.1 Select local times to be saved "Time" in output file |
---|
| 463 | !============================================================================== |
---|
| 464 | write(*,*) 'number of local time to be used ?' |
---|
| 465 | read(*,*) nhour |
---|
[2204] | 466 | allocate(lt_hour(nhour),stat=ierr) |
---|
| 467 | if (ierr.ne.0) then |
---|
| 468 | write(*,*) "Error: failed to allocate lt_hour(nhour)" |
---|
| 469 | stop |
---|
| 470 | endif |
---|
[137] | 471 | write(*,*) 'list of selected local time (0<t<24)' |
---|
| 472 | do it=1,nhour |
---|
[2434] | 473 | read(*,*) lt_hour(it) |
---|
[137] | 474 | end do |
---|
| 475 | |
---|
| 476 | if ((timelen.eq.12).and.(time(1).eq.2).and.(time(timelen).eq.24))then |
---|
[2434] | 477 | write(*,*) 'We detect a ""stats"" file' |
---|
| 478 | stats=.true. |
---|
| 479 | timelen_lt=nhour |
---|
| 480 | allocate(lt_out(timelen_lt),stat=ierr) |
---|
| 481 | if (ierr.ne.0) then |
---|
| 482 | write(*,*) "Error: failed to allocate lt_hour(nhour)" |
---|
| 483 | stop |
---|
| 484 | endif |
---|
| 485 | do it=1,nhour |
---|
| 486 | lt_out(it)=lt_hour(it)/24. |
---|
| 487 | end do |
---|
[137] | 488 | ! We rewrite the time from "stats" from 0 to 1 sol... |
---|
[2434] | 489 | do it=1,timelen ! loop temps in |
---|
| 490 | time(it) = time(it)/24. |
---|
| 491 | end do |
---|
| 492 | nsol =1 |
---|
[137] | 493 | else ! case of a diagfi or concatnc file |
---|
| 494 | stats=.false. |
---|
| 495 | ! Number of sol in input file |
---|
| 496 | nsol = int(time(timelen)) - int(time(1)) |
---|
| 497 | timelen_lt=nhour*nsol |
---|
[2204] | 498 | allocate(lt_out(timelen_lt),stat=ierr) |
---|
| 499 | if (ierr.ne.0) then |
---|
| 500 | write(*,*) "Error: failed to allocate lt_hour(nhour)" |
---|
| 501 | stop |
---|
| 502 | endif |
---|
[137] | 503 | i=0 |
---|
| 504 | do k=1,nsol |
---|
| 505 | do it=1,nhour |
---|
| 506 | i=i+1 |
---|
| 507 | lt_out(i)=int(time(1)) + k-1 + lt_hour(it)/24. |
---|
| 508 | end do |
---|
| 509 | end do |
---|
[2434] | 510 | end if |
---|
[137] | 511 | |
---|
| 512 | if (nsol.gt.1) then |
---|
| 513 | timelen_tot=timelen |
---|
| 514 | else |
---|
| 515 | ! if only 1 sol available, we must add 1 timestep for the interpolation |
---|
| 516 | timelen_tot=timelen+1 |
---|
| 517 | endif |
---|
[2204] | 518 | allocate(lt_gcm(timelen_tot),stat=ierr) |
---|
| 519 | if (ierr.ne.0) then |
---|
| 520 | write(*,*) "Error: failed to allocate lt_gcm(timelen_tot)" |
---|
| 521 | stop |
---|
| 522 | endif |
---|
| 523 | allocate(var_gcm(timelen_tot),stat=ierr) |
---|
| 524 | if (ierr.ne.0) then |
---|
| 525 | write(*,*) "Error: failed to allocate var_gcm(timelen_tot)" |
---|
| 526 | stop |
---|
| 527 | endif |
---|
| 528 | allocate(lt_outc(timelen_lt),stat=ierr) |
---|
| 529 | if (ierr.ne.0) then |
---|
| 530 | write(*,*) "Error: failed to allocate lt_outc(timelen_lt)" |
---|
| 531 | stop |
---|
| 532 | endif |
---|
[137] | 533 | |
---|
| 534 | !============================================================================== |
---|
| 535 | ! 2.4.1.5 Initiate dimension in output file |
---|
| 536 | !============================================================================== |
---|
| 537 | |
---|
| 538 | |
---|
| 539 | ! Initialize output file's lat,lon,alt and time dimensions |
---|
[2434] | 540 | call initiate(filename,lat,lon,alt,ctl,latlen,lonlen,altlen,ctllen,GCM_layers,& |
---|
[2227] | 541 | altlong_name,altunits,altpositive,& |
---|
[2434] | 542 | nout,latdimout,londimout,altdimout,timedimout,& |
---|
| 543 | layerdimout,timevarout) |
---|
[2204] | 544 | |
---|
[137] | 545 | ! Initialize output file's aps,bps and phisinit variables |
---|
[2434] | 546 | call init2(nid,lonlen,latlen,altlen,GCM_layers,& |
---|
| 547 | nout,londimout,latdimout,altdimout,& |
---|
| 548 | layerdimout) |
---|
[137] | 549 | |
---|
| 550 | |
---|
| 551 | !============================================================================== |
---|
| 552 | ! 2.4.2 Write/extend "Time" dimension/values in output file |
---|
| 553 | !============================================================================== |
---|
| 554 | |
---|
| 555 | if (stats) then |
---|
| 556 | |
---|
| 557 | do it=1,timelen_lt |
---|
[2567] | 558 | ierr= NF_PUT_VARA_REAL(nout,timevarout,(/it/),(/1/),lt_hour(it)) |
---|
[137] | 559 | enddo |
---|
| 560 | else |
---|
| 561 | do it=1,timelen_lt |
---|
[2567] | 562 | ierr= NF_PUT_VARA_REAL(nout,timevarout,(/it/),(/1/),lt_out(it)) |
---|
[2147] | 563 | if (ierr.NE.NF_NOERR) then |
---|
| 564 | write(*,*) "Error , failed to write Time" |
---|
| 565 | stop |
---|
| 566 | endif |
---|
[137] | 567 | enddo |
---|
| 568 | end if |
---|
| 569 | |
---|
| 570 | !============================================================================== |
---|
| 571 | ! 2.5 Read/write variables |
---|
| 572 | !============================================================================== |
---|
| 573 | |
---|
| 574 | do j=1,nbvar ! loop on variables to read/write |
---|
| 575 | |
---|
| 576 | !============================================================================== |
---|
| 577 | ! 2.5.1 Check that variable to be read existe in input file |
---|
| 578 | !============================================================================== |
---|
| 579 | |
---|
| 580 | write(*,*) "variable ",var(j) |
---|
| 581 | ierr=nf_inq_varid(nid,var(j),varid) |
---|
| 582 | if (ierr.NE.NF_NOERR) then |
---|
| 583 | write(*,*) 'ERROR: Field <',var(j),'> not found in file'//file |
---|
[2567] | 584 | stop |
---|
[137] | 585 | endif |
---|
| 586 | ierr=nf_inq_varndims(nid,varid,ndim) |
---|
| 587 | |
---|
[2434] | 588 | ! Check that it is a 3D or 4D variable |
---|
| 589 | if (ndim.lt.3) then |
---|
| 590 | write(*,*) "Error:",trim(var(j))," is nor a 3D neither a 4D variable" |
---|
| 591 | write(*,*) "We'll skip that variable..." |
---|
| 592 | CYCLE ! go directly to the next variable |
---|
| 593 | endif |
---|
[137] | 594 | !============================================================================== |
---|
| 595 | ! 2.5.2 Prepare things in order to read/write the variable |
---|
| 596 | !============================================================================== |
---|
| 597 | |
---|
| 598 | ! build dim(),corner() and edges() arrays |
---|
| 599 | ! and allocate var3d() array |
---|
| 600 | if (ndim==3) then |
---|
| 601 | allocate(var3d(lonlen,latlen,timelen,1)) |
---|
| 602 | allocate(var3d_lt(lonlen,latlen,timelen_lt,1)) |
---|
| 603 | dim(1)=londimout |
---|
| 604 | dim(2)=latdimout |
---|
| 605 | dim(3)=timedimout |
---|
| 606 | |
---|
| 607 | ! start indexes (where data values will be written) |
---|
| 608 | corner(1)=1 |
---|
| 609 | corner(2)=1 |
---|
| 610 | corner(3)=1 |
---|
| 611 | corner(4)=1 |
---|
| 612 | |
---|
[2204] | 613 | ! length (along dimensions) of block of data to be written |
---|
[137] | 614 | edges(1)=lonlen |
---|
| 615 | edges(2)=latlen |
---|
| 616 | edges(3)=timelen_lt |
---|
| 617 | edges(4)=1 |
---|
| 618 | |
---|
| 619 | else if (ndim==4) then |
---|
| 620 | allocate(var3d(lonlen,latlen,altlen,timelen)) |
---|
| 621 | allocate(var3d_lt(lonlen,latlen,altlen,timelen_lt)) |
---|
| 622 | dim(1)=londimout |
---|
| 623 | dim(2)=latdimout |
---|
| 624 | dim(3)=altdimout |
---|
| 625 | dim(4)=timedimout |
---|
| 626 | |
---|
| 627 | ! start indexes (where data values will be written) |
---|
| 628 | corner(1)=1 |
---|
| 629 | corner(2)=1 |
---|
| 630 | corner(3)=1 |
---|
| 631 | corner(4)=1 |
---|
| 632 | |
---|
[2204] | 633 | ! length (along dimensions) of block of data to be written |
---|
[137] | 634 | edges(1)=lonlen |
---|
| 635 | edges(2)=latlen |
---|
| 636 | edges(3)=altlen |
---|
| 637 | edges(4)=timelen_lt |
---|
| 638 | endif |
---|
| 639 | |
---|
[2434] | 640 | units=" " |
---|
| 641 | long_name=" " |
---|
[2438] | 642 | ierr=nf_get_att_text(nid,varid,"long_name",long_name) |
---|
[2434] | 643 | if (ierr.ne.nf_noerr) then |
---|
| 644 | ! if no attribute "long_name", try "title" |
---|
[2438] | 645 | ierr=nf_get_att_text(nid,varid,"title",long_name) |
---|
[2434] | 646 | endif |
---|
| 647 | ierr=nf_get_att_text(nid,varid,"units",units) |
---|
| 648 | call def_var(nout,var(j),long_name,units,ndim,dim,varidout,ierr) |
---|
[137] | 649 | |
---|
| 650 | |
---|
| 651 | |
---|
| 652 | !============================================================================== |
---|
| 653 | ! 2.5.3 Read from input file |
---|
| 654 | !============================================================================== |
---|
| 655 | |
---|
| 656 | ierr = NF_GET_VAR_REAL(nid,varid,var3d) |
---|
[2577] | 657 | miss=NF_GET_ATT_REAL(nid,varid,"missing_value",[missing]) |
---|
[2227] | 658 | validr=NF_GET_ATT_REAL(nid,varid,"valid_range",valid_range) |
---|
[137] | 659 | |
---|
| 660 | !============================================================================== |
---|
| 661 | ! 2.5.4 Read from input file |
---|
| 662 | !============================================================================== |
---|
| 663 | ! Interpolation in local time : |
---|
| 664 | |
---|
| 665 | do ilon=1,lonlen |
---|
| 666 | ! write(*,*) 'processing longitude =', lon(ilon) |
---|
| 667 | ! Local time at each longitude : |
---|
| 668 | do it=1,timelen ! loop temps in |
---|
| 669 | lt_gcm(it) = time(it) +0.5*lon(ilon)/180. |
---|
| 670 | end do |
---|
| 671 | if (nsol.eq.1) lt_gcm(timelen+1) = lt_gcm(1)+1 |
---|
| 672 | |
---|
| 673 | do it=1,timelen_lt ! loop time local time |
---|
| 674 | lt_outc(it)=lt_out(it) |
---|
| 675 | ! Correction to use same local time previous or following |
---|
| 676 | ! day where data are missing : |
---|
| 677 | |
---|
| 678 | if(lt_outc(it).gt.lt_gcm(timelen_tot))lt_outc(it)=lt_out(it)-1 |
---|
| 679 | if(lt_outc(it).lt.lt_gcm(1))lt_outc(it)=lt_out(it)+1 |
---|
| 680 | end do |
---|
| 681 | |
---|
| 682 | if (ndim==3) then |
---|
| 683 | do ilat=1,latlen |
---|
| 684 | do it=1,timelen ! loop temps in |
---|
| 685 | var_gcm(it) = var3d(ilon,ilat,it,1) |
---|
| 686 | end do |
---|
| 687 | if (nsol.eq.1) var_gcm(timelen+1) = var_gcm(1) |
---|
| 688 | do it=1,timelen_lt ! loop time local time |
---|
| 689 | call interpolf(lt_outc(it),var3d_lt(ilon,ilat,it,1),& |
---|
| 690 | missing,lt_gcm,var_gcm,timelen_tot) |
---|
| 691 | end do |
---|
| 692 | enddo |
---|
| 693 | |
---|
| 694 | else if (ndim==4) then |
---|
| 695 | do ilat=1,latlen |
---|
| 696 | do ialt=1,altlen |
---|
| 697 | do it=1,timelen ! loop temps in |
---|
| 698 | var_gcm(it) = var3d(ilon,ilat,ialt,it) |
---|
| 699 | end do |
---|
| 700 | if (nsol.eq.1) var_gcm(timelen+1) = var_gcm(1) |
---|
| 701 | do it=1,timelen_lt ! loop time local time |
---|
| 702 | call interpolf(lt_outc(it),var3d_lt(ilon,ilat,ialt,it),& |
---|
| 703 | missing,lt_gcm,var_gcm,timelen_tot) |
---|
| 704 | end do |
---|
| 705 | enddo |
---|
| 706 | enddo |
---|
| 707 | end if |
---|
| 708 | |
---|
| 709 | end do |
---|
| 710 | |
---|
| 711 | |
---|
| 712 | !============================================================================== |
---|
| 713 | ! 2.5.5 write (append) to the output file |
---|
| 714 | !============================================================================== |
---|
| 715 | |
---|
| 716 | ierr= NF_PUT_VARA_REAL(nout,varidout,corner,edges,var3d_lt) |
---|
| 717 | |
---|
| 718 | if (ierr.ne.NF_NOERR) then |
---|
| 719 | write(*,*) 'PUT_VAR ERROR: ',NF_STRERROR(ierr) |
---|
[2567] | 720 | stop |
---|
[137] | 721 | endif |
---|
| 722 | |
---|
| 723 | ! In case there is a "valid_range" attribute |
---|
| 724 | ! Write "valid_range" and "missing_value" attributes in output file |
---|
| 725 | if (miss.eq.NF_NOERR) then |
---|
[2227] | 726 | call missing_value(nout,varidout,validr,miss,valid_range,missing) |
---|
[137] | 727 | endif |
---|
| 728 | |
---|
| 729 | ! free var3d() array |
---|
| 730 | deallocate(var3d) |
---|
| 731 | deallocate(var3d_lt) |
---|
| 732 | |
---|
| 733 | enddo ! of do j=1,nbvar |
---|
| 734 | |
---|
| 735 | deallocate(time) |
---|
| 736 | deallocate(lt_gcm) |
---|
| 737 | deallocate(lt_out) |
---|
| 738 | deallocate(lt_outc) |
---|
| 739 | deallocate(var_gcm) |
---|
| 740 | |
---|
| 741 | ! Close input file |
---|
| 742 | ierr=nf_close(nid) |
---|
| 743 | |
---|
| 744 | ! Close output file |
---|
| 745 | ierr=NF_CLOSE(nout) |
---|
| 746 | |
---|
[2434] | 747 | write(*,*) "Program completed !" |
---|
| 748 | |
---|
[137] | 749 | contains |
---|
| 750 | |
---|
| 751 | !****************************************************************************** |
---|
[2434] | 752 | Subroutine initiate(filename,lat,lon,alt,ctl,latlen,lonlen,altlen,ctllen,GCM_layers,& |
---|
[2227] | 753 | altlong_name,altunits,altpositive,& |
---|
[2434] | 754 | nout,latdimout,londimout,altdimout,timedimout,& |
---|
| 755 | layerdimout,timevarout) |
---|
[137] | 756 | !============================================================================== |
---|
| 757 | ! Purpose: |
---|
| 758 | ! Create and initialize a data file (NetCDF format) |
---|
| 759 | !============================================================================== |
---|
| 760 | ! Remarks: |
---|
| 761 | ! The NetCDF file (created in this subroutine) remains open |
---|
| 762 | !============================================================================== |
---|
| 763 | |
---|
| 764 | implicit none |
---|
| 765 | |
---|
| 766 | include "netcdf.inc" ! NetCDF definitions |
---|
| 767 | |
---|
| 768 | !============================================================================== |
---|
| 769 | ! Arguments: |
---|
| 770 | !============================================================================== |
---|
| 771 | character (len=*), intent(in):: filename |
---|
| 772 | ! filename(): the file's name |
---|
[2207] | 773 | integer,intent(in) ::latlen,lonlen,altlen,ctllen |
---|
[2204] | 774 | real, intent(in):: lat(latlen) |
---|
[137] | 775 | ! lat(): latitude |
---|
[2204] | 776 | real, intent(in):: lon(lonlen) |
---|
[137] | 777 | ! lon(): longitude |
---|
[2204] | 778 | real, intent(in):: alt(altlen) |
---|
[137] | 779 | ! alt(): altitude |
---|
[2204] | 780 | real, intent(in):: ctl(ctllen) |
---|
[1073] | 781 | ! ctl(): controle |
---|
[2434] | 782 | integer,intent(in) :: GCM_layers ! number of GCM layers |
---|
[2227] | 783 | character (len=*), intent(in) :: altlong_name |
---|
| 784 | ! altlong_name(): [netcdf] altitude "long_name" attribute |
---|
| 785 | character (len=*), intent(in) :: altunits |
---|
| 786 | ! altunits(): [netcdf] altitude "units" attribute |
---|
| 787 | character (len=*), intent(in) :: altpositive |
---|
| 788 | ! altpositive(): [netcdf] altitude "positive" attribute |
---|
[137] | 789 | integer, intent(out):: nout |
---|
| 790 | ! nout: [netcdf] file ID |
---|
| 791 | integer, intent(out):: latdimout |
---|
| 792 | ! latdimout: [netcdf] lat() (i.e.: latitude) ID |
---|
| 793 | integer, intent(out):: londimout |
---|
| 794 | ! londimout: [netcdf] lon() ID |
---|
| 795 | integer, intent(out):: altdimout |
---|
| 796 | ! altdimout: [netcdf] alt() ID |
---|
| 797 | integer, intent(out):: timedimout |
---|
| 798 | ! timedimout: [netcdf] "Time" ID |
---|
[2434] | 799 | integer,intent(out) :: layerdimout |
---|
| 800 | ! layerdimout: [netcdf] "GCM_layers" ID |
---|
[137] | 801 | integer, intent(out):: timevarout |
---|
| 802 | ! timevarout: [netcdf] "Time" (considered as a variable) ID |
---|
| 803 | |
---|
| 804 | !============================================================================== |
---|
| 805 | ! Local variables: |
---|
| 806 | !============================================================================== |
---|
| 807 | !integer :: latdim,londim,altdim,timedim |
---|
| 808 | integer :: nvarid,ierr |
---|
[1073] | 809 | integer :: ctldimout |
---|
[137] | 810 | ! nvarid: [netcdf] ID of a variable |
---|
| 811 | ! ierr: [netcdf] return error code (from called subroutines) |
---|
| 812 | |
---|
| 813 | !============================================================================== |
---|
| 814 | ! 1. Create (and open) output file |
---|
| 815 | !============================================================================== |
---|
| 816 | write(*,*) "creating "//trim(adjustl(filename))//'...' |
---|
[410] | 817 | ierr = NF_CREATE(filename,IOR(NF_CLOBBER,NF_64BIT_OFFSET),nout) |
---|
[137] | 818 | ! NB: setting NF_CLOBBER mode means that it's OK to overwrite an existing file |
---|
| 819 | if (ierr.NE.NF_NOERR) then |
---|
[2204] | 820 | WRITE(*,*)'ERROR: Impossible to create the file ',trim(filename) |
---|
| 821 | write(*,*) NF_STRERROR(ierr) |
---|
[2567] | 822 | stop |
---|
[137] | 823 | endif |
---|
| 824 | |
---|
| 825 | !============================================================================== |
---|
| 826 | ! 2. Define/write "dimensions" and get their IDs |
---|
| 827 | !============================================================================== |
---|
| 828 | |
---|
[2204] | 829 | ierr = NF_DEF_DIM(nout, "latitude", latlen, latdimout) |
---|
| 830 | if (ierr.NE.NF_NOERR) then |
---|
| 831 | WRITE(*,*)'initiate: error failed to define dimension <latitude>' |
---|
| 832 | write(*,*) NF_STRERROR(ierr) |
---|
[2567] | 833 | stop |
---|
[2204] | 834 | endif |
---|
| 835 | ierr = NF_DEF_DIM(nout, "longitude", lonlen, londimout) |
---|
| 836 | if (ierr.NE.NF_NOERR) then |
---|
| 837 | WRITE(*,*)'initiate: error failed to define dimension <longitude>' |
---|
| 838 | write(*,*) NF_STRERROR(ierr) |
---|
[2567] | 839 | stop |
---|
[2204] | 840 | endif |
---|
| 841 | ierr = NF_DEF_DIM(nout, "altitude", altlen, altdimout) |
---|
| 842 | if (ierr.NE.NF_NOERR) then |
---|
| 843 | WRITE(*,*)'initiate: error failed to define dimension <altitude>' |
---|
| 844 | write(*,*) NF_STRERROR(ierr) |
---|
[2567] | 845 | stop |
---|
[2204] | 846 | endif |
---|
| 847 | if (size(ctl).ne.0) then |
---|
| 848 | ierr = NF_DEF_DIM(nout, "index", ctllen, ctldimout) |
---|
| 849 | if (ierr.NE.NF_NOERR) then |
---|
| 850 | WRITE(*,*)'initiate: error failed to define dimension <index>' |
---|
| 851 | write(*,*) NF_STRERROR(ierr) |
---|
[2567] | 852 | stop |
---|
[2204] | 853 | endif |
---|
| 854 | endif |
---|
[137] | 855 | ierr = NF_DEF_DIM(nout, "Time", NF_UNLIMITED, timedimout) |
---|
[2204] | 856 | if (ierr.NE.NF_NOERR) then |
---|
| 857 | WRITE(*,*)'initiate: error failed to define dimension <Time>' |
---|
| 858 | write(*,*) NF_STRERROR(ierr) |
---|
[2567] | 859 | stop |
---|
[2204] | 860 | endif |
---|
[137] | 861 | |
---|
[2434] | 862 | ierr = NF_DEF_DIM(nout, "GCM_layers", GCM_layers, layerdimout) |
---|
| 863 | |
---|
[137] | 864 | ! End netcdf define mode |
---|
| 865 | ierr = NF_ENDDEF(nout) |
---|
[2204] | 866 | if (ierr.NE.NF_NOERR) then |
---|
| 867 | WRITE(*,*)'initiate: error failed to switch out of define mode' |
---|
| 868 | write(*,*) NF_STRERROR(ierr) |
---|
[2567] | 869 | stop |
---|
[2204] | 870 | endif |
---|
[137] | 871 | |
---|
| 872 | !============================================================================== |
---|
| 873 | ! 3. Write "Time" and its attributes |
---|
| 874 | !============================================================================== |
---|
| 875 | |
---|
| 876 | call def_var(nout,"Time","Time","years since 0000-00-0 00:00:00",1,& |
---|
| 877 | (/timedimout/),timevarout,ierr) |
---|
| 878 | |
---|
| 879 | !============================================================================== |
---|
| 880 | ! 4. Write "latitude" (data and attributes) |
---|
| 881 | !============================================================================== |
---|
| 882 | |
---|
| 883 | call def_var(nout,"latitude","latitude","degrees_north",1,& |
---|
| 884 | (/latdimout/),nvarid,ierr) |
---|
| 885 | |
---|
| 886 | ierr = NF_PUT_VAR_REAL (nout,nvarid,lat) |
---|
[2204] | 887 | if (ierr.NE.NF_NOERR) then |
---|
| 888 | WRITE(*,*)'initiate: error failed writing variable <latitude>' |
---|
| 889 | write(*,*) NF_STRERROR(ierr) |
---|
[2567] | 890 | stop |
---|
[2204] | 891 | endif |
---|
[137] | 892 | |
---|
| 893 | !============================================================================== |
---|
| 894 | ! 4. Write "longitude" (data and attributes) |
---|
| 895 | !============================================================================== |
---|
| 896 | |
---|
| 897 | call def_var(nout,"longitude","East longitude","degrees_east",1,& |
---|
| 898 | (/londimout/),nvarid,ierr) |
---|
| 899 | |
---|
[2434] | 900 | |
---|
[137] | 901 | ierr = NF_PUT_VAR_REAL (nout,nvarid,lon) |
---|
[2204] | 902 | if (ierr.NE.NF_NOERR) then |
---|
| 903 | WRITE(*,*)'initiate: error failed writing variable <longitude>' |
---|
| 904 | write(*,*) NF_STRERROR(ierr) |
---|
[2567] | 905 | stop |
---|
[2204] | 906 | endif |
---|
[137] | 907 | |
---|
| 908 | !============================================================================== |
---|
[1073] | 909 | ! 5. Write "altitude" (data and attributes) |
---|
[137] | 910 | !============================================================================== |
---|
| 911 | |
---|
| 912 | ! Switch to netcdf define mode |
---|
| 913 | ierr = NF_REDEF (nout) |
---|
| 914 | |
---|
[2577] | 915 | ierr = NF_DEF_VAR (nout,"altitude",NF_FLOAT,1,[altdimout],nvarid) |
---|
[137] | 916 | |
---|
[2227] | 917 | ierr = NF_PUT_ATT_TEXT (nout,nvarid,'long_name',len_trim(adjustl(altlong_name)),adjustl(altlong_name)) |
---|
| 918 | ierr = NF_PUT_ATT_TEXT (nout,nvarid,'units',len_trim(adjustl(altunits)),adjustl(altunits)) |
---|
| 919 | ierr = NF_PUT_ATT_TEXT (nout,nvarid,'positive',len_trim(adjustl(altpositive)),adjustl(altpositive)) |
---|
[137] | 920 | |
---|
| 921 | ! End netcdf define mode |
---|
| 922 | ierr = NF_ENDDEF(nout) |
---|
| 923 | |
---|
[2434] | 924 | ierr = NF_PUT_VAR_REAL (nout,nvarid,alt) |
---|
[2204] | 925 | if (ierr.NE.NF_NOERR) then |
---|
| 926 | WRITE(*,*)'initiate: error failed writing variable <altitude>' |
---|
| 927 | write(*,*) NF_STRERROR(ierr) |
---|
[2567] | 928 | stop |
---|
[2204] | 929 | endif |
---|
[137] | 930 | |
---|
[1073] | 931 | !============================================================================== |
---|
| 932 | ! 6. Write "controle" (data and attributes) |
---|
| 933 | !============================================================================== |
---|
| 934 | |
---|
| 935 | if (size(ctl).ne.0) then |
---|
| 936 | ! Switch to netcdf define mode |
---|
| 937 | ierr = NF_REDEF (nout) |
---|
| 938 | |
---|
[2577] | 939 | ierr = NF_DEF_VAR (nout,"controle",NF_FLOAT,1,[ctldimout],nvarid) |
---|
[1073] | 940 | |
---|
[2434] | 941 | ierr = NF_PUT_ATT_TEXT (nout,nvarid,"long_name",18,"Control parameters") |
---|
[1073] | 942 | |
---|
| 943 | ! End netcdf define mode |
---|
| 944 | ierr = NF_ENDDEF(nout) |
---|
| 945 | |
---|
| 946 | ierr = NF_PUT_VAR_REAL (nout,nvarid,ctl) |
---|
[2204] | 947 | if (ierr.NE.NF_NOERR) then |
---|
| 948 | WRITE(*,*)'initiate: error failed writing variable <controle>' |
---|
| 949 | write(*,*) NF_STRERROR(ierr) |
---|
[2567] | 950 | stop |
---|
[2204] | 951 | endif |
---|
[1073] | 952 | endif |
---|
| 953 | |
---|
[137] | 954 | end Subroutine initiate |
---|
| 955 | !****************************************************************************** |
---|
[2434] | 956 | subroutine init2(infid,lonlen,latlen,altlen,GCM_layers,& |
---|
| 957 | outfid,londimout,latdimout,altdimout,& |
---|
| 958 | layerdimout) |
---|
[137] | 959 | !============================================================================== |
---|
| 960 | ! Purpose: |
---|
[2227] | 961 | ! Copy aps(), bps() and phisinit() from input file to output file |
---|
[137] | 962 | !============================================================================== |
---|
| 963 | ! Remarks: |
---|
| 964 | ! The NetCDF files must be open |
---|
| 965 | !============================================================================== |
---|
| 966 | |
---|
| 967 | implicit none |
---|
| 968 | |
---|
| 969 | include "netcdf.inc" ! NetCDF definitions |
---|
| 970 | |
---|
| 971 | !============================================================================== |
---|
| 972 | ! Arguments: |
---|
| 973 | !============================================================================== |
---|
| 974 | integer, intent(in) :: infid ! NetCDF output file ID |
---|
| 975 | integer, intent(in) :: lonlen ! # of grid points along longitude |
---|
| 976 | integer, intent(in) :: latlen ! # of grid points along latitude |
---|
[2204] | 977 | integer, intent(in) :: altlen ! # of grid points along altitude |
---|
[2434] | 978 | integer, intent(in) :: GCM_layers ! # of GCM atmospheric layers |
---|
[137] | 979 | integer, intent(in) :: outfid ! NetCDF output file ID |
---|
| 980 | integer, intent(in) :: londimout ! longitude dimension ID |
---|
| 981 | integer, intent(in) :: latdimout ! latitude dimension ID |
---|
| 982 | integer, intent(in) :: altdimout ! altitude dimension ID |
---|
[2434] | 983 | integer, intent(in) :: layerdimout ! GCM_layers dimension ID |
---|
[137] | 984 | !============================================================================== |
---|
| 985 | ! Local variables: |
---|
| 986 | !============================================================================== |
---|
| 987 | real,dimension(:),allocatable :: aps,bps ! hybrid vertical coordinates |
---|
| 988 | real,dimension(:,:),allocatable :: phisinit ! Ground geopotential |
---|
| 989 | integer :: apsid,bpsid,phisinitid |
---|
| 990 | integer :: ierr |
---|
[2204] | 991 | integer :: tmpdimid ! temporary dimension ID |
---|
[137] | 992 | integer :: tmpvarid ! temporary variable ID |
---|
[2434] | 993 | logical :: phis, hybrid ! are "phisinit" and "aps"/"bps" available ? |
---|
[137] | 994 | |
---|
| 995 | |
---|
| 996 | !============================================================================== |
---|
| 997 | ! 1. Read data from input file |
---|
| 998 | !============================================================================== |
---|
| 999 | |
---|
| 1000 | ! hybrid coordinate aps |
---|
[2434] | 1001 | !write(*,*) "aps: altlen=",altlen," GCM_layers=",GCM_layers |
---|
| 1002 | allocate(aps(GCM_layers),stat=ierr) |
---|
| 1003 | if (ierr.ne.0) then |
---|
| 1004 | write(*,*) "init2: failed to allocate aps!" |
---|
| 1005 | stop |
---|
| 1006 | endif |
---|
[137] | 1007 | ierr=NF_INQ_VARID(infid,"aps",tmpvarid) |
---|
| 1008 | if (ierr.ne.NF_NOERR) then |
---|
[2434] | 1009 | write(*,*) "Ooops. Failed to get aps ID. OK." |
---|
| 1010 | hybrid=.false. |
---|
[137] | 1011 | else |
---|
[2434] | 1012 | hybrid=.true. |
---|
| 1013 | ierr=NF_GET_VAR_REAL(infid,tmpvarid,aps) |
---|
| 1014 | hybrid=.true. |
---|
| 1015 | if (ierr.ne.NF_NOERR) then |
---|
[2567] | 1016 | write(*,*) "init2 Error: Failed reading aps" |
---|
| 1017 | stop |
---|
[137] | 1018 | endif |
---|
| 1019 | |
---|
[2434] | 1020 | ! hybrid coordinate bps |
---|
| 1021 | ! write(*,*) "bps: altlen=",altlen," GCM_layers=",GCM_layers |
---|
| 1022 | allocate(bps(GCM_layers),stat=ierr) |
---|
[2204] | 1023 | if (ierr.ne.0) then |
---|
[2434] | 1024 | write(*,*) "init2: failed to allocate bps!" |
---|
[2204] | 1025 | stop |
---|
| 1026 | endif |
---|
[2434] | 1027 | ierr=NF_INQ_VARID(infid,"bps",tmpvarid) |
---|
| 1028 | if (ierr.ne.NF_NOERR) then |
---|
| 1029 | write(*,*) "Ooops. Failed to get bps ID. OK." |
---|
| 1030 | hybrid=.false. |
---|
[2204] | 1031 | else |
---|
| 1032 | ierr=NF_GET_VAR_REAL(infid,tmpvarid,bps) |
---|
| 1033 | if (ierr.ne.NF_NOERR) then |
---|
[2567] | 1034 | write(*,*) "init2 Error: Failed reading bps" |
---|
| 1035 | stop |
---|
[2204] | 1036 | endif |
---|
[137] | 1037 | endif |
---|
| 1038 | endif |
---|
| 1039 | |
---|
| 1040 | ! ground geopotential phisinit |
---|
[2204] | 1041 | allocate(phisinit(lonlen,latlen),stat=ierr) |
---|
| 1042 | if (ierr.ne.0) then |
---|
| 1043 | write(*,*) "init2: failed to allocate phisinit(lonlen,latlen)" |
---|
| 1044 | stop |
---|
| 1045 | endif |
---|
[137] | 1046 | ierr=NF_INQ_VARID(infid,"phisinit",tmpvarid) |
---|
| 1047 | if (ierr.ne.NF_NOERR) then |
---|
| 1048 | write(*,*) "Failed to get phisinit ID. OK" |
---|
| 1049 | phisinit = 0. |
---|
| 1050 | phis = .false. |
---|
| 1051 | else |
---|
| 1052 | ierr=NF_GET_VAR_REAL(infid,tmpvarid,phisinit) |
---|
| 1053 | if (ierr.ne.NF_NOERR) then |
---|
[2567] | 1054 | write(*,*) "init2 Error: Failed reading phisinit" |
---|
| 1055 | stop |
---|
[137] | 1056 | endif |
---|
| 1057 | phis = .true. |
---|
| 1058 | endif |
---|
| 1059 | |
---|
| 1060 | |
---|
| 1061 | !============================================================================== |
---|
| 1062 | ! 2. Write |
---|
| 1063 | !============================================================================== |
---|
| 1064 | |
---|
| 1065 | !============================================================================== |
---|
| 1066 | ! 2.2. Hybrid coordinates aps() and bps() |
---|
| 1067 | !============================================================================== |
---|
| 1068 | |
---|
[2434] | 1069 | IF (hybrid) then |
---|
[2204] | 1070 | ! define aps |
---|
| 1071 | call def_var(outfid,"aps","hybrid pressure at midlayers"," ",1,& |
---|
[2434] | 1072 | (/layerdimout/),apsid,ierr) |
---|
[2204] | 1073 | if (ierr.ne.NF_NOERR) then |
---|
[2567] | 1074 | write(*,*) "Error: Failed to def_var aps" |
---|
| 1075 | stop |
---|
[2204] | 1076 | endif |
---|
[137] | 1077 | |
---|
[2204] | 1078 | ! write aps |
---|
| 1079 | ierr=NF_PUT_VAR_REAL(outfid,apsid,aps) |
---|
| 1080 | if (ierr.ne.NF_NOERR) then |
---|
[2567] | 1081 | write(*,*) "Error: Failed to write aps" |
---|
| 1082 | stop |
---|
[2204] | 1083 | endif |
---|
[2434] | 1084 | |
---|
[2204] | 1085 | ! define bps |
---|
| 1086 | call def_var(outfid,"bps","hybrid sigma at midlayers"," ",1,& |
---|
[2434] | 1087 | (/layerdimout/),bpsid,ierr) |
---|
[2204] | 1088 | if (ierr.ne.NF_NOERR) then |
---|
[2567] | 1089 | write(*,*) "Error: Failed to def_var bps" |
---|
| 1090 | stop |
---|
[2204] | 1091 | endif |
---|
[137] | 1092 | |
---|
[2204] | 1093 | ! write bps |
---|
| 1094 | ierr=NF_PUT_VAR_REAL(outfid,bpsid,bps) |
---|
| 1095 | if (ierr.ne.NF_NOERR) then |
---|
[2567] | 1096 | write(*,*) "Error: Failed to write bps" |
---|
| 1097 | stop |
---|
[2204] | 1098 | endif |
---|
[2434] | 1099 | |
---|
| 1100 | deallocate(aps) |
---|
| 1101 | deallocate(bps) |
---|
| 1102 | ENDIF ! of IF (hybrid) |
---|
[137] | 1103 | |
---|
| 1104 | !============================================================================== |
---|
| 1105 | ! 2.2. phisinit() |
---|
| 1106 | !============================================================================== |
---|
| 1107 | |
---|
| 1108 | IF (phis) THEN |
---|
| 1109 | |
---|
[2204] | 1110 | !define phisinit |
---|
| 1111 | call def_var(outfid,"phisinit","Ground level geopotential"," ",2,& |
---|
| 1112 | (/londimout,latdimout/),phisinitid,ierr) |
---|
| 1113 | if (ierr.ne.NF_NOERR) then |
---|
[2567] | 1114 | write(*,*) "Error: Failed to def_var phisinit" |
---|
| 1115 | stop |
---|
[137] | 1116 | endif |
---|
| 1117 | |
---|
[2204] | 1118 | ! write phisinit |
---|
| 1119 | ierr=NF_PUT_VAR_REAL(outfid,phisinitid,phisinit) |
---|
| 1120 | if (ierr.ne.NF_NOERR) then |
---|
[2567] | 1121 | write(*,*) "Error: Failed to write phisinit" |
---|
| 1122 | stop |
---|
[2204] | 1123 | endif |
---|
[137] | 1124 | |
---|
[2434] | 1125 | deallocate(phisinit) |
---|
[2204] | 1126 | ENDIF ! of IF (phis) |
---|
[137] | 1127 | |
---|
| 1128 | |
---|
[2434] | 1129 | end subroutine init2 |
---|
[137] | 1130 | |
---|
| 1131 | !****************************************************************************** |
---|
[2434] | 1132 | subroutine def_var(nid,name,long_name,units,nbdim,dim,nvarid,ierr) |
---|
[137] | 1133 | !============================================================================== |
---|
| 1134 | ! Purpose: Write a variable (i.e: add a variable to a dataset) |
---|
[2434] | 1135 | ! called "name"; along with its attributes "long_name", "units"... |
---|
[137] | 1136 | ! to a file (following the NetCDF format) |
---|
| 1137 | !============================================================================== |
---|
| 1138 | ! Remarks: |
---|
| 1139 | ! The NetCDF file must be open |
---|
| 1140 | !============================================================================== |
---|
| 1141 | |
---|
| 1142 | implicit none |
---|
| 1143 | |
---|
| 1144 | include "netcdf.inc" ! NetCDF definitions |
---|
| 1145 | |
---|
| 1146 | !============================================================================== |
---|
| 1147 | ! Arguments: |
---|
| 1148 | !============================================================================== |
---|
| 1149 | integer, intent(in) :: nid |
---|
| 1150 | ! nid: [netcdf] file ID # |
---|
| 1151 | character (len=*), intent(in) :: name |
---|
| 1152 | ! name(): [netcdf] variable's name |
---|
[2434] | 1153 | character (len=*), intent(in) :: long_name |
---|
| 1154 | ! long_name(): [netcdf] variable's "long_name" attribute |
---|
[137] | 1155 | character (len=*), intent(in) :: units |
---|
| 1156 | ! unit(): [netcdf] variable's "units" attribute |
---|
| 1157 | integer, intent(in) :: nbdim |
---|
| 1158 | ! nbdim: number of dimensions of the variable |
---|
| 1159 | integer, dimension(nbdim), intent(in) :: dim |
---|
| 1160 | ! dim(nbdim): [netcdf] dimension(s) ID(s) |
---|
| 1161 | integer, intent(out) :: nvarid |
---|
| 1162 | ! nvarid: [netcdf] ID # of the variable |
---|
| 1163 | integer, intent(out) :: ierr |
---|
| 1164 | ! ierr: [netcdf] subroutines returned error code |
---|
| 1165 | |
---|
| 1166 | ! Switch to netcdf define mode |
---|
| 1167 | ierr=NF_REDEF(nid) |
---|
| 1168 | |
---|
| 1169 | ! Insert the definition of the variable |
---|
| 1170 | ierr=NF_DEF_VAR(nid,adjustl(name),NF_FLOAT,nbdim,dim,nvarid) |
---|
| 1171 | |
---|
| 1172 | ! Write the attributes |
---|
[2434] | 1173 | ierr=NF_PUT_ATT_TEXT(nid,nvarid,"long_name",len_trim(adjustl(long_name)),adjustl(long_name)) |
---|
[137] | 1174 | ierr=NF_PUT_ATT_TEXT(nid,nvarid,"units",len_trim(adjustl(units)),adjustl(units)) |
---|
| 1175 | |
---|
| 1176 | ! End netcdf define mode |
---|
| 1177 | ierr=NF_ENDDEF(nid) |
---|
| 1178 | |
---|
| 1179 | end subroutine def_var |
---|
| 1180 | !****************************************************************************** |
---|
[2227] | 1181 | subroutine missing_value(nout,nvarid,validr,miss,valid_range,missing) |
---|
[137] | 1182 | !============================================================================== |
---|
| 1183 | ! Purpose: |
---|
| 1184 | ! Write "valid_range" and "missing_value" attributes (of a given |
---|
| 1185 | ! variable) to a netcdf file |
---|
| 1186 | !============================================================================== |
---|
| 1187 | ! Remarks: |
---|
| 1188 | ! NetCDF file must be open |
---|
| 1189 | ! Variable (nvarid) ID must be set |
---|
| 1190 | !============================================================================== |
---|
| 1191 | |
---|
| 1192 | implicit none |
---|
| 1193 | |
---|
| 1194 | include "netcdf.inc" ! NetCDF definitions |
---|
| 1195 | |
---|
| 1196 | !============================================================================== |
---|
| 1197 | ! Arguments: |
---|
| 1198 | !============================================================================== |
---|
| 1199 | integer, intent(in) :: nout |
---|
| 1200 | ! nout: [netcdf] file ID # |
---|
| 1201 | integer, intent(in) :: nvarid |
---|
| 1202 | ! varid: [netcdf] variable ID # |
---|
[2227] | 1203 | integer, intent(in) :: validr |
---|
| 1204 | ! validr : [netcdf] routines return code for "valid_range" attribute |
---|
| 1205 | integer, intent(in) :: miss |
---|
| 1206 | ! miss : [netcdf] routines return code for "missing_value" attribute |
---|
[137] | 1207 | real, dimension(2), intent(in) :: valid_range |
---|
| 1208 | ! valid_range(2): [netcdf] "valid_range" attribute (min and max) |
---|
| 1209 | real, intent(in) :: missing |
---|
| 1210 | ! missing: [netcdf] "missing_value" attribute |
---|
| 1211 | |
---|
| 1212 | !============================================================================== |
---|
| 1213 | ! Local variables: |
---|
| 1214 | !============================================================================== |
---|
| 1215 | integer :: ierr |
---|
| 1216 | ! ierr: [netcdf] subroutine returned error code |
---|
| 1217 | ! INTEGER nout,nvarid,ierr |
---|
| 1218 | ! REAL missing |
---|
| 1219 | ! REAL valid_range(2) |
---|
| 1220 | |
---|
| 1221 | ! Switch to netcdf dataset define mode |
---|
| 1222 | ierr = NF_REDEF (nout) |
---|
| 1223 | if (ierr.ne.NF_NOERR) then |
---|
| 1224 | print*,'missing_value: ' |
---|
| 1225 | print*, NF_STRERROR(ierr) |
---|
| 1226 | endif |
---|
| 1227 | |
---|
| 1228 | ! Write valid_range() attribute |
---|
[2227] | 1229 | if (validr.eq.NF_NOERR) then |
---|
| 1230 | ierr=NF_PUT_ATT_REAL(nout,nvarid,'valid_range',NF_FLOAT,2,valid_range) |
---|
[137] | 1231 | |
---|
[2227] | 1232 | if (ierr.ne.NF_NOERR) then |
---|
| 1233 | print*,'missing_value: valid_range attribution failed' |
---|
| 1234 | print*, NF_STRERROR(ierr) |
---|
| 1235 | !write(*,*) 'NF_NOERR', NF_NOERR |
---|
| 1236 | !CALL abort |
---|
[2567] | 1237 | stop |
---|
[2227] | 1238 | endif |
---|
[137] | 1239 | endif |
---|
[2434] | 1240 | if (miss.eq.NF_NOERR) then |
---|
[137] | 1241 | ! Write "missing_value" attribute |
---|
[2577] | 1242 | ierr= NF_PUT_ATT_REAL(nout,nvarid,'missing_value',NF_FLOAT,1,[missing]) |
---|
[137] | 1243 | |
---|
[2227] | 1244 | if (ierr.NE.NF_NOERR) then |
---|
| 1245 | print*, 'missing_value: missing value attribution failed' |
---|
| 1246 | print*, NF_STRERROR(ierr) |
---|
| 1247 | ! WRITE(*,*) 'NF_NOERR', NF_NOERR |
---|
| 1248 | ! CALL abort |
---|
[2567] | 1249 | stop |
---|
[2227] | 1250 | endif |
---|
[137] | 1251 | endif |
---|
| 1252 | |
---|
| 1253 | ! End netcdf dataset define mode |
---|
| 1254 | ierr = NF_ENDDEF(nout) |
---|
| 1255 | |
---|
| 1256 | end subroutine missing_value |
---|
| 1257 | |
---|
| 1258 | !***************************************************************************** |
---|
| 1259 | subroutine interpolf(x,y,missing,xd,yd,nd) |
---|
| 1260 | !============================================================================== |
---|
| 1261 | ! Purpose: |
---|
| 1262 | ! Yield y=f(x), where xd() end yd() are arrays of known values, |
---|
| 1263 | ! using linear interpolation |
---|
| 1264 | ! If x is not included in the interval spaned by xd(), then y is set |
---|
| 1265 | ! to a default value 'missing' |
---|
| 1266 | ! Note: |
---|
| 1267 | ! Array xd() should contain ordered (either increasing or decreasing) abscissas |
---|
| 1268 | !============================================================================== |
---|
| 1269 | implicit none |
---|
| 1270 | !============================================================================== |
---|
| 1271 | ! Arguments: |
---|
| 1272 | !============================================================================== |
---|
| 1273 | real,intent(in) :: x ! abscissa at which interpolation is to be done |
---|
| 1274 | real,intent(in) :: missing ! missing value (if no interpolation is performed) |
---|
| 1275 | integer :: nd ! size of arrays |
---|
| 1276 | real,dimension(nd),intent(in) :: xd ! array of known absissas |
---|
| 1277 | real,dimension(nd),intent(in) :: yd ! array of correponding values |
---|
| 1278 | |
---|
| 1279 | real,intent(out) :: y ! interpolated value |
---|
| 1280 | !============================================================================== |
---|
| 1281 | ! Local variables: |
---|
| 1282 | !============================================================================== |
---|
| 1283 | integer :: i |
---|
| 1284 | |
---|
| 1285 | ! default: set y to 'missing' |
---|
| 1286 | y=missing |
---|
| 1287 | |
---|
| 1288 | do i=1,nd-1 |
---|
| 1289 | if (((x.ge.xd(i)).and.(x.le.xd(i+1))).or.& |
---|
| 1290 | ((x.le.xd(i)).and.(x.ge.xd(i+1)))) then |
---|
[2215] | 1291 | if ((yd(i).eq.missing).or.(yd(i+1).eq.missing)) then |
---|
| 1292 | ! cannot perform the interpolation if an encompasing value |
---|
| 1293 | ! is already set to 'missing' |
---|
| 1294 | else |
---|
| 1295 | !linear interpolation based on encompassing values |
---|
| 1296 | y=yd(i)+(x-xd(i))*(yd(i+1)-yd(i))/(xd(i+1)-xd(i)) |
---|
| 1297 | endif |
---|
[137] | 1298 | exit |
---|
| 1299 | endif |
---|
| 1300 | enddo |
---|
| 1301 | |
---|
| 1302 | |
---|
| 1303 | end subroutine interpolf |
---|
| 1304 | |
---|
[2204] | 1305 | !****************************************************************************** |
---|
| 1306 | |
---|
| 1307 | end program localtime |
---|
| 1308 | |
---|