[137] | 1 | |
---|
| 2 | |
---|
| 3 | program lslin |
---|
| 4 | |
---|
| 5 | ! Program to interpolate data in Solar Longitude linear time coordinate |
---|
| 6 | ! (usable with grads) from Netcdf diagfi or concatnc files |
---|
| 7 | ! author Y. Wanherdrick, K. Dassas 2004 |
---|
| 8 | ! Modified by F.Forget 04/2005 |
---|
| 9 | ! More modifications by Ehouarn Millour 12/2005 |
---|
| 10 | ! Modified by Ehouarn Millour 10/2007 (changed evaluation of 'start_var' |
---|
| 11 | ! from hard-coded values to a computed value) |
---|
[1073] | 12 | ! Read controle field, if available TN, October 2013 |
---|
[1409] | 13 | ! Allow to chose a starting Ls and to average within Ls timestep a |
---|
| 14 | ! (great to compare with TES and MCS data. F. Forget december 2013) |
---|
[137] | 15 | |
---|
[1073] | 16 | |
---|
[137] | 17 | implicit none |
---|
| 18 | |
---|
| 19 | include "netcdf.inc" ! NetCDF definitions |
---|
| 20 | |
---|
| 21 | character (len=50) :: infile |
---|
| 22 | ! infile(): input file name |
---|
| 23 | character (len=50), dimension(:), allocatable :: var |
---|
| 24 | ! var(): names of the variables |
---|
| 25 | character (len=50) :: title,units |
---|
| 26 | ! title(),units(): [netcdf] "title" and "units" attributes |
---|
[1409] | 27 | character (len=50) :: units_alt |
---|
| 28 | ! var(): units of altitude which can be 'km' or 'Pa' (after zrecast) |
---|
[137] | 29 | character (len=100) :: outfile |
---|
| 30 | ! outfile(): output file name |
---|
| 31 | character (len=100) :: vartmp |
---|
| 32 | ! vartmp(): used for temporary storage of various strings |
---|
| 33 | character (len=1) :: answer |
---|
| 34 | ! answer: the character 'y' (or 'Y'), if input file is of 'concatnc' type |
---|
[1409] | 35 | character (len=1) :: average |
---|
| 36 | ! average: the character 'y' to average within the Ls timestep |
---|
| 37 | integer :: nid,varid,ierr,miss |
---|
[137] | 38 | ! nid: [netcdf] ID # of input file |
---|
| 39 | ! varid: [netcdf] ID # of a variable |
---|
| 40 | ! ierr: [netcdf] error code (returned by subroutines) |
---|
| 41 | integer :: nout,varidout |
---|
| 42 | ! nout: [netcdf] ID # of output file |
---|
| 43 | ! varidout: [netcdf] ID # of a variable (to write in the output file) |
---|
[1409] | 44 | integer :: i,j,k,l,x,y,n |
---|
[137] | 45 | ! counters for various loops |
---|
| 46 | integer :: start_var |
---|
| 47 | ! starting index/ID # from which physical variables are to be found |
---|
| 48 | integer :: reptime ! Ehouarn: integer or real ? |
---|
| 49 | ! rep_time: starting date/time of the run (given by user) |
---|
| 50 | integer :: day_ini ! Ehouarn: integer or real ? |
---|
| 51 | ! day_ini: starting date/time of the run stored in input file |
---|
| 52 | integer, parameter :: length=100 |
---|
| 53 | ! length: (default) lenght of tab_cntrl() |
---|
| 54 | real, dimension(length) :: tab_cntrl |
---|
| 55 | ! tab_cntrl(length): array, stored in the input file, |
---|
| 56 | ! which contains various control parameters. |
---|
| 57 | real, dimension(:), allocatable:: lat,lon,alt,time,lsgcm,timels |
---|
| 58 | ! lat(): latitude coordinates (read from input file) |
---|
| 59 | ! lon(): longitude coordinates (read from input file) |
---|
| 60 | ! alt(): altitude coordinates (read from input file) |
---|
| 61 | ! time(): time coordinates (in "sol", read from input file) |
---|
| 62 | ! lsgcm(): time coordinate (in unevenly spaced "Ls") |
---|
| 63 | ! timels(): new time coordinates (evenly spaced "Ls"; written to output file) |
---|
[1409] | 64 | integer :: latlen,lonlen,altlen,timelen,Nls,Sls |
---|
[137] | 65 | ! latlen: # of elements of lat() array |
---|
| 66 | ! lonlen: # of elements of lon() array |
---|
| 67 | ! altvar: # of elements of alt() array |
---|
| 68 | ! timelen: # of elements of time() and lsgcm() arrays |
---|
| 69 | ! Nls: # of elements of timels() array |
---|
| 70 | integer :: nbvarfile,nbvar,ndim !,nbfile |
---|
| 71 | ! nbvar: # of time-dependent variables |
---|
| 72 | ! nbvarfile: total # of variables (in netcdf file) |
---|
| 73 | ! ndim: [netcdf] # of dimensions (3 or 4) of a variable |
---|
| 74 | integer :: latdim,londim,altdim,timedim |
---|
| 75 | ! latdim: [netcdf] "latitude" dim ID |
---|
| 76 | ! londim: [netcdf] "longitude" dim ID |
---|
| 77 | ! altdim: [netcdf] "altdim" dim ID |
---|
| 78 | ! timedim: [netcdf] "timedim" dim ID |
---|
| 79 | integer :: latvar,lonvar,altvar,timevar |
---|
| 80 | ! latvar: [netcdf] ID of "latitude" variable |
---|
| 81 | ! lonvar: [netcdf] ID of "longitude" variable |
---|
| 82 | ! altvar: [netcdf] ID of "altitude" variable |
---|
| 83 | ! timevar: [netcdf] ID of "Time" variable |
---|
| 84 | integer :: latdimout,londimout,altdimout,timedimout,timevarout |
---|
| 85 | ! latdimout: [netcdf] output latitude (dimension) ID |
---|
| 86 | ! londimout: [netcdf] output longitude (dimension) ID |
---|
| 87 | ! altdimout: [netcdf] output altitude (dimension) ID |
---|
| 88 | ! timedimout: [netcdf] output time (dimension) ID |
---|
| 89 | ! timevarout: [netcdf] ID of output "Time" variable |
---|
| 90 | integer, dimension(4) :: corner,edges,dim |
---|
| 91 | ! corner(4): [netcdf] start indexes (where block of data will be written) |
---|
| 92 | ! edges(4): [netcdf] lenght (along dimensions) of block of data to write |
---|
| 93 | ! dim(4): [netcdf] lat, long, alt and time dimensions |
---|
| 94 | real, dimension(:,:,:,:), allocatable :: var3d,var3dls |
---|
| 95 | ! var3d(,,,): 4D array to store a variable (on initial lat/lon/alt/sol grid) |
---|
| 96 | ! var3dls(,,,): 4D array to store a variable (on new lat/lon/alt/Ls grid) |
---|
| 97 | real, dimension(:), allocatable :: var3dxy |
---|
| 98 | ! var3dxy(): to store the temporal evolution of a variable (at fixed lat/lon/alt) |
---|
[1409] | 99 | real :: deltatsol,deltals,resultat,ls0 |
---|
[137] | 100 | ! deltatsol: time step (in sols) of input file data |
---|
| 101 | ! deltals: time step (in Ls) for the data sent to output |
---|
[1409] | 102 | ! ls0: first Ls value for the data sent to output |
---|
[137] | 103 | ! resultat: to temporarily store the result of the interpolation |
---|
| 104 | character (len=3) :: mon |
---|
| 105 | ! mon(3): to store (and write to file) the 3 first letters of a month |
---|
| 106 | real :: date |
---|
| 107 | ! date: used to compute/build a fake date (for grads output) |
---|
[1409] | 108 | real :: missing |
---|
| 109 | ! to handle missing value when reading /writing files |
---|
| 110 | real, dimension(2) :: valid_range |
---|
| 111 | ! valid range |
---|
[137] | 112 | |
---|
| 113 | !============================================================================== |
---|
| 114 | ! 1. Initialisation step |
---|
| 115 | !============================================================================== |
---|
| 116 | |
---|
| 117 | !============================================================================== |
---|
| 118 | ! 1.1. Get input file name and 'type' (to initialize start_var and reptime) |
---|
| 119 | !============================================================================== |
---|
| 120 | |
---|
| 121 | write(*,*) "which file do you want to use?" |
---|
| 122 | read(*,'(a50)') infile |
---|
| 123 | |
---|
[1073] | 124 | !write(*,*) "Is it a concatnc file? (y/n)?" |
---|
| 125 | write(*,*) "Do you want to specify the beginning day of the file" |
---|
| 126 | write(*,*) "in case the controle field is not present ? (y/n)?" |
---|
[137] | 127 | read(*,*) answer |
---|
| 128 | if ((answer=="y").or.(answer=="Y")) then |
---|
[1073] | 129 | write(*,*) "Beginning day of the file?" |
---|
[137] | 130 | read(*,*) reptime |
---|
| 131 | ! start_var=8 ! 'concatnc' type of file |
---|
| 132 | !else |
---|
| 133 | ! start_var=16 ! 'diagfi' type of file |
---|
| 134 | ! N.B.: start_var is now computed; see below |
---|
| 135 | endif |
---|
| 136 | |
---|
| 137 | |
---|
| 138 | !============================================================================== |
---|
| 139 | ! 1.2. Open input file and read/list the variables it contains |
---|
| 140 | !============================================================================== |
---|
| 141 | |
---|
| 142 | write(*,*) "opening "//trim(infile)//"..." |
---|
| 143 | ierr = NF_OPEN(infile,NF_NOWRITE,nid) |
---|
| 144 | if (ierr.NE.NF_NOERR) then |
---|
| 145 | write(*,*) 'Failed to open file '//infile |
---|
| 146 | write(*,*) NF_STRERROR(ierr) |
---|
| 147 | stop "" |
---|
| 148 | endif |
---|
| 149 | |
---|
| 150 | ! Compute 'start_var', the index from which variables are lon-lat-time |
---|
| 151 | ! and/or lon-lat-alt-time |
---|
| 152 | ! WARNING: We assume here that the ordering of variables in the NetCDF |
---|
| 153 | ! file is such that 0D, 1D and 2D variables are placed BEFORE 3D and 4D |
---|
| 154 | ! variables |
---|
| 155 | |
---|
| 156 | i=1 ! dummy initialization to enter loop below |
---|
| 157 | start_var=0 ! initialization |
---|
| 158 | do while (i.lt.3) |
---|
| 159 | start_var=start_var+1 |
---|
| 160 | ! request number of dims of variable number 'start_var' |
---|
| 161 | ierr=NF_INQ_VARNDIMS(nid,start_var,i) |
---|
| 162 | if (ierr.ne.NF_NOERR) then |
---|
| 163 | write(*,*) "Failed to get number of dims for variable number:",start_var |
---|
| 164 | write(*,*) NF_STRERROR(ierr) |
---|
| 165 | stop "" |
---|
| 166 | endif |
---|
| 167 | enddo |
---|
| 168 | write(*,*) "start_var=",start_var |
---|
| 169 | |
---|
| 170 | |
---|
| 171 | ierr=NF_INQ_NVARS(nid,nbvarfile) |
---|
| 172 | ! nbvarfile is now equal to the (total) number of variables in input file |
---|
| 173 | |
---|
| 174 | allocate(var(nbvarfile-(start_var-1))) |
---|
| 175 | |
---|
| 176 | ! Yield the list of variables (to the screen) |
---|
| 177 | write(*,*) |
---|
| 178 | do i=start_var,nbvarfile |
---|
| 179 | ierr=NF_INQ_VARNAME(nid,i,vartmp) |
---|
| 180 | write(*,*) trim(vartmp) |
---|
| 181 | enddo |
---|
| 182 | !nbvar=0 |
---|
| 183 | |
---|
| 184 | ! Ehouarn: Redundant (and obsolete) lines ? |
---|
| 185 | ! nbvar=nbvarfile-(start_var-1) |
---|
| 186 | ! do j=start_var,nbvarfile |
---|
| 187 | ! ierr=nf_inq_varname(nid,j,var(j-(start_var-1))) |
---|
| 188 | ! enddo |
---|
| 189 | |
---|
| 190 | ! Get the variables' names from the input file (and store them in var()) |
---|
| 191 | nbvar=nbvarfile-(start_var-1) |
---|
| 192 | do i=1,nbvar |
---|
| 193 | ierr=NF_INQ_VARNAME(nid,i+(start_var-1),var(i)) |
---|
| 194 | write(*,'(a9,1x,i2,1x,a1,1x,a50)') "variable ",i,":",var(i) |
---|
| 195 | enddo |
---|
| 196 | |
---|
| 197 | !============================================================================== |
---|
| 198 | ! 1.3. Output file name |
---|
| 199 | !============================================================================== |
---|
| 200 | ! outfile="lslin.nc" |
---|
| 201 | outfile=infile(1:len_trim(infile)-3)//"_Ls.nc" |
---|
| 202 | write(*,*) outfile |
---|
| 203 | |
---|
| 204 | |
---|
| 205 | !============================================================================== |
---|
| 206 | ! 2. Work: read input, build new time coordinate and write it to output |
---|
| 207 | !============================================================================== |
---|
| 208 | |
---|
| 209 | !============================================================================== |
---|
| 210 | ! 2.1. Read (and check) latitude, longitude and altitude from input file |
---|
| 211 | !============================================================================== |
---|
| 212 | |
---|
| 213 | ierr=NF_INQ_DIMID(nid,"latitude",latdim) |
---|
| 214 | ierr=NF_INQ_VARID(nid,"latitude",latvar) |
---|
| 215 | if (ierr.NE.NF_NOERR) then |
---|
| 216 | write(*,*) 'ERROR: Field <latitude> is missing' |
---|
| 217 | write(*,*) NF_STRERROR(ierr) |
---|
| 218 | stop "" |
---|
| 219 | endif |
---|
| 220 | ierr=NF_INQ_DIMLEN(nid,latdim,latlen) |
---|
| 221 | ! write(*,*) "latlen: ",latlen |
---|
| 222 | |
---|
| 223 | ierr=NF_INQ_DIMID(nid,"longitude",londim) |
---|
| 224 | ierr=NF_INQ_VARID(nid,"longitude",lonvar) |
---|
| 225 | if (ierr.NE.NF_NOERR) then |
---|
| 226 | write(*,*) 'ERROR: Field <longitude> is missing' |
---|
| 227 | write(*,*) NF_STRERROR(ierr) |
---|
| 228 | stop "" |
---|
| 229 | endif |
---|
| 230 | ierr=NF_INQ_DIMLEN(nid,londim,lonlen) |
---|
| 231 | ! write(*,*) "lonlen: ",lonlen |
---|
| 232 | |
---|
| 233 | ierr=NF_INQ_DIMID(nid,"altitude",altdim) |
---|
| 234 | ierr=NF_INQ_VARID(nid,"altitude",altvar) |
---|
| 235 | if (ierr.NE.NF_NOERR) then |
---|
| 236 | write(*,*) 'ERROR: Field <altitude> is missing' |
---|
| 237 | write(*,*) NF_STRERROR(ierr) |
---|
| 238 | ! stop "" |
---|
| 239 | altlen = 1 |
---|
| 240 | else |
---|
| 241 | ierr=NF_INQ_DIMLEN(nid,altdim,altlen) |
---|
[1409] | 242 | units_alt=" " |
---|
| 243 | ierr=NF_GET_ATT_TEXT(nid,varid,"units",units_alt) |
---|
[137] | 244 | endif |
---|
| 245 | write(*,*) "altlen: ",altlen |
---|
| 246 | |
---|
| 247 | ! Allocate lat(), lon() and alt() |
---|
| 248 | allocate(lat(latlen)) |
---|
| 249 | allocate(lon(lonlen)) |
---|
| 250 | allocate(alt(altlen)) |
---|
| 251 | |
---|
| 252 | ! Read lat(),lon() and alt() from input file |
---|
| 253 | |
---|
| 254 | |
---|
| 255 | |
---|
| 256 | |
---|
| 257 | |
---|
| 258 | ierr = NF_GET_VAR_REAL(nid,latvar,lat) |
---|
| 259 | ierr = NF_GET_VAR_REAL(nid,lonvar,lon) |
---|
| 260 | ierr = NF_GET_VAR_REAL(nid,altvar,alt) |
---|
| 261 | if (ierr.NE.NF_NOERR) then |
---|
| 262 | if (altlen.eq.1) alt(1)=0. |
---|
| 263 | end if |
---|
| 264 | |
---|
| 265 | |
---|
| 266 | !============================================================================== |
---|
| 267 | ! 2.2. Create (and initialize latitude, longitude and altitude in) output file |
---|
| 268 | !============================================================================== |
---|
| 269 | |
---|
| 270 | call initiate(outfile,lat,lon,alt,nout,& |
---|
[1409] | 271 | latdimout,londimout,altdimout,timedimout,timevarout,units_alt) |
---|
[137] | 272 | |
---|
| 273 | !============================================================================== |
---|
| 274 | ! 2.3. Read time from input file |
---|
| 275 | !============================================================================== |
---|
| 276 | |
---|
| 277 | ierr=NF_INQ_DIMID(nid,"Time",timedim) |
---|
| 278 | if (ierr.NE.NF_NOERR) then |
---|
| 279 | write(*,*) 'ERROR: Dimension <Time> is missing' |
---|
| 280 | write(*,*) NF_STRERROR(ierr) |
---|
| 281 | stop "" |
---|
| 282 | endif |
---|
| 283 | ierr=NF_INQ_VARID(nid,"Time",timevar) |
---|
| 284 | if (ierr.NE.NF_NOERR) then |
---|
| 285 | write(*,*) 'ERROR: Field <Time> is missing' |
---|
| 286 | write(*,*) NF_STRERROR(ierr) |
---|
| 287 | stop "" |
---|
| 288 | endif |
---|
| 289 | |
---|
| 290 | ierr=NF_INQ_DIMLEN(nid,timedim,timelen) |
---|
| 291 | write(*,*) "timelen: ",timelen |
---|
| 292 | |
---|
| 293 | allocate(time(timelen)) |
---|
| 294 | allocate(lsgcm(timelen)) |
---|
| 295 | |
---|
| 296 | |
---|
| 297 | |
---|
| 298 | |
---|
| 299 | ierr = NF_GET_VAR_REAL(nid,timevar,time) |
---|
| 300 | |
---|
| 301 | |
---|
| 302 | !============================================================================== |
---|
| 303 | ! 2.4. Initialize day_ini (starting day of the run) |
---|
| 304 | !============================================================================== |
---|
| 305 | |
---|
| 306 | |
---|
| 307 | write(*,*) 'answer',answer |
---|
| 308 | if ((answer/="y").and.(answer/="Y")) then |
---|
| 309 | ! input file is of 'concatnc' type; the starting date of the run |
---|
| 310 | ! is stored in the "controle" array |
---|
| 311 | ierr = NF_INQ_VARID (nid, "controle", varid) |
---|
| 312 | if (ierr .NE. NF_NOERR) then |
---|
| 313 | write(*,*) 'ERROR: <controle> variable is missing' |
---|
| 314 | write(*,*) NF_STRERROR(ierr) |
---|
| 315 | stop "" |
---|
| 316 | endif |
---|
| 317 | |
---|
| 318 | |
---|
| 319 | |
---|
| 320 | |
---|
| 321 | ierr = NF_GET_VAR_REAL(nid, varid, tab_cntrl) |
---|
| 322 | |
---|
| 323 | |
---|
| 324 | if (ierr .NE. NF_NOERR) then |
---|
| 325 | write(*,*) 'ERROR: Failed to read <controle>' |
---|
| 326 | write(*,*) NF_STRERROR(ierr) |
---|
| 327 | stop "" |
---|
| 328 | endif |
---|
| 329 | |
---|
[1073] | 330 | day_ini = tab_cntrl(4) |
---|
| 331 | day_ini = modulo(day_ini,669) |
---|
[137] | 332 | write(*,*) 'day_ini', day_ini |
---|
| 333 | else |
---|
| 334 | day_ini= reptime |
---|
| 335 | write(*,*) 'day_ini', day_ini |
---|
| 336 | endif |
---|
| 337 | |
---|
| 338 | !============================================================================== |
---|
| 339 | ! 2.5. Build timels() (i.e.: time, but in evenly spaced "Ls" time steps) |
---|
| 340 | !============================================================================== |
---|
| 341 | |
---|
| 342 | ! compute time step, in sols, of input dataset |
---|
| 343 | deltatsol=time(2)-time(1) |
---|
| 344 | write(*,*) 'deltatsol',deltatsol |
---|
| 345 | |
---|
| 346 | ! compute time/dates in "Ls"; result stored in lsgcm() |
---|
| 347 | do i=1,timelen |
---|
| 348 | call sol2ls(day_ini+time(i),lsgcm(i)) |
---|
[1409] | 349 | if (lsgcm(i).lt.lsgcm(1)) lsgcm(i)=lsgcm(i) + 360. |
---|
[137] | 350 | enddo |
---|
| 351 | |
---|
| 352 | write(*,*) 'Input data LS range :', lsgcm(1),lsgcm(timelen) |
---|
| 353 | |
---|
| 354 | !****************************************** |
---|
| 355 | write(*,*) "Automatic Ls timetsep (y/n)?" |
---|
| 356 | read(*,*) answer |
---|
| 357 | if ((answer=="y").or.(answer=="Y")) then |
---|
| 358 | ! ********************************************* |
---|
| 359 | ! Trick of the trade: |
---|
| 360 | ! Use the value of deltatsol to determine |
---|
| 361 | ! a suitable value for deltals |
---|
| 362 | ! ********************************************* |
---|
| 363 | deltals=1./12. |
---|
| 364 | if (0.6*deltatsol.ge.1/6.) deltals=1./6. |
---|
| 365 | if (0.6*deltatsol.ge.0.25) deltals=0.25 |
---|
| 366 | if (0.6*deltatsol.ge.0.5) deltals=0.5 |
---|
| 367 | if (0.6*deltatsol.ge.0.75) deltals=0.75 |
---|
| 368 | if (0.6*deltatsol.ge.1) deltals=1. |
---|
| 369 | if (0.6*deltatsol.ge.2) deltals=2. |
---|
| 370 | if (0.6*deltatsol.ge.3) deltals=3. |
---|
| 371 | if (0.6*deltatsol.ge.5) deltals=5. |
---|
[1409] | 372 | ls0=lsgcm(1) ! First Ls date |
---|
[137] | 373 | else |
---|
| 374 | write(*,*) "New timestep in Ls (deg)" |
---|
| 375 | read(*,*) deltals |
---|
[1409] | 376 | write(*,*) "First Ls (deg)" |
---|
| 377 | read(*,*) ls0 |
---|
| 378 | if (ls0.lt.lsgcm(1)) then |
---|
| 379 | write(*,*) 'with this file, the earliest Ls is ',lsgcm(1),'let s use it' |
---|
| 380 | ls0=lsgcm(1) |
---|
| 381 | end if |
---|
| 382 | write(*,*) "First Ls date (deg) = ", ls0 ! FF2013 |
---|
| 383 | |
---|
| 384 | do while((average.ne.'y').and.(average.ne.'n')) |
---|
| 385 | write(*,*) "Average data within the Ls timestep (y/n) or interpolate ? " |
---|
| 386 | read(*,*) average |
---|
| 387 | end do |
---|
[137] | 388 | endif |
---|
[1409] | 389 | NLs=int(Int((lsgcm(timelen)-ls0)/deltals) +1) ! FF2013 |
---|
[137] | 390 | !******************************************** |
---|
| 391 | allocate(timels(Nls)) |
---|
| 392 | |
---|
| 393 | ! Build timels() |
---|
[1409] | 394 | timels(1) = 0.01*nint(100.*ls0) ! Ehouarn: what the !!!???!!! |
---|
[137] | 395 | do k=2,Nls |
---|
| 396 | timels(k) = timels(k-1) + deltals |
---|
| 397 | end do |
---|
| 398 | |
---|
| 399 | write(*,*) 'timestep in Ls (deg) ', deltals |
---|
| 400 | write(*,*) 'output data LS range : ', timels(1),timels(Nls) |
---|
| 401 | |
---|
| 402 | !============================================================================== |
---|
| 403 | ! 2.6. Write timels() to output file |
---|
| 404 | !============================================================================== |
---|
| 405 | |
---|
| 406 | do k=1,Nls |
---|
| 407 | |
---|
| 408 | |
---|
| 409 | |
---|
| 410 | ierr= NF_PUT_VARA_REAL(nout,timevarout,k,1,timels(k)) |
---|
| 411 | |
---|
| 412 | enddo |
---|
| 413 | |
---|
| 414 | |
---|
| 415 | !============================================================================== |
---|
| 416 | ! 3. Read variables, interpolate them along the new time coordinate |
---|
| 417 | ! and send the result to output |
---|
| 418 | !============================================================================== |
---|
| 419 | |
---|
| 420 | do j=1,nbvar ! loop on the variables to read/interpolate/write |
---|
| 421 | |
---|
| 422 | !============================================================================== |
---|
| 423 | ! 3.1 Check that variable exists, and get some of its attributes |
---|
| 424 | !============================================================================== |
---|
| 425 | write(*,*) "variable ",var(j) |
---|
| 426 | ! Get the variable's ID |
---|
| 427 | ierr=NF_INQ_VARID(nid,var(j),varid) |
---|
| 428 | if (ierr.NE.NF_NOERR) then |
---|
| 429 | write(*,*) 'ERROR: Field <',var(j),'> not found' |
---|
| 430 | write(*,*) NF_STRERROR(ierr) |
---|
| 431 | stop "" |
---|
| 432 | endif |
---|
| 433 | ! Get the value of 'ndim' for this varriable |
---|
| 434 | ierr=NF_INQ_VARNDIMS(nid,varid,ndim) |
---|
| 435 | write(*,*) 'ndim', ndim |
---|
| 436 | |
---|
| 437 | !============================================================================== |
---|
| 438 | ! 3.2 Prepare a few things in order to interpolate/write |
---|
| 439 | !============================================================================== |
---|
| 440 | |
---|
| 441 | if (ndim==3) then |
---|
| 442 | allocate(var3d(lonlen,latlen,timelen,1)) |
---|
| 443 | allocate(var3dls(lonlen,latlen,Nls,1)) |
---|
| 444 | allocate(var3dxy(timelen)) |
---|
| 445 | |
---|
| 446 | dim(1)=londimout |
---|
| 447 | dim(2)=latdimout |
---|
| 448 | dim(3)=timedimout |
---|
| 449 | |
---|
| 450 | corner(1)=1 |
---|
| 451 | corner(2)=1 |
---|
| 452 | corner(3)=1 |
---|
| 453 | corner(4)=1 |
---|
| 454 | |
---|
| 455 | edges(1)=lonlen |
---|
| 456 | edges(2)=latlen |
---|
| 457 | edges(3)=Nls |
---|
| 458 | edges(4)=1 |
---|
| 459 | |
---|
| 460 | else if (ndim==4) then |
---|
| 461 | allocate(var3d(lonlen,latlen,altlen,timelen)) |
---|
| 462 | allocate(var3dls(lonlen,latlen,altlen,Nls)) |
---|
| 463 | allocate(var3dxy(timelen)) |
---|
| 464 | |
---|
| 465 | dim(1)=londimout |
---|
| 466 | dim(2)=latdimout |
---|
| 467 | dim(3)=altdimout |
---|
| 468 | dim(4)=timedimout |
---|
| 469 | |
---|
| 470 | corner(1)=1 |
---|
| 471 | corner(2)=1 |
---|
| 472 | corner(3)=1 |
---|
| 473 | corner(4)=1 |
---|
| 474 | |
---|
| 475 | edges(1)=lonlen |
---|
| 476 | edges(2)=latlen |
---|
| 477 | edges(3)=altlen |
---|
| 478 | edges(4)=Nls |
---|
| 479 | endif |
---|
| 480 | |
---|
| 481 | !============================================================================== |
---|
| 482 | ! 3.3 Write this variable's definition and attributes to the output file |
---|
| 483 | !============================================================================== |
---|
| 484 | units=" " |
---|
| 485 | title=" " |
---|
| 486 | ierr=NF_GET_ATT_TEXT(nid,varid,"title",title) |
---|
| 487 | ierr=NF_GET_ATT_TEXT(nid,varid,"units",units) |
---|
| 488 | |
---|
| 489 | call def_var(nout,var(j),title,units,ndim,dim,varidout,ierr) |
---|
| 490 | |
---|
| 491 | !============================================================================== |
---|
| 492 | ! 3.4 Read variable |
---|
| 493 | !============================================================================== |
---|
| 494 | |
---|
| 495 | |
---|
| 496 | |
---|
| 497 | |
---|
| 498 | ierr = NF_GET_VAR_REAL(nid,varid,var3d) |
---|
[1409] | 499 | miss = NF_GET_ATT_REAL(nid,varid,"missing_value",missing) |
---|
| 500 | miss = NF_GET_ATT_REAL(nid,varid,"valid_range",valid_range) |
---|
[137] | 501 | |
---|
| 502 | |
---|
| 503 | !============================================================================== |
---|
[1409] | 504 | ! 3.6 interpolate or average |
---|
[137] | 505 | !============================================================================== |
---|
| 506 | |
---|
| 507 | ! 2D variable (lon, lat, time) |
---|
| 508 | ! interpolation of var at timels |
---|
| 509 | if (ndim==3) then |
---|
| 510 | do x=1,lonlen |
---|
| 511 | do y=1,latlen |
---|
| 512 | ! write(*,*) 'd: x, y', x, y |
---|
| 513 | do l=1,timelen |
---|
[1409] | 514 | var3dxy(l)=var3d(x,y,l,1) |
---|
[137] | 515 | enddo |
---|
[1409] | 516 | do n=1,Nls |
---|
| 517 | if(average.eq.'y') then |
---|
| 518 | resultat=0. |
---|
| 519 | Sls=0 ! (gcm data counter within each Ls timestep) |
---|
| 520 | do l=1,timelen |
---|
| 521 | if((lsgcm(l).ge.(timels(n)-deltals/2.)).and. & |
---|
| 522 | (lsgcm(l).lt.(timels(n)+deltals/2.))) then |
---|
| 523 | if(var3dxy(l) .ne. missing) then |
---|
| 524 | Sls= Sls +1 |
---|
| 525 | resultat = resultat + var3dxy(l) |
---|
| 526 | end if |
---|
| 527 | end if |
---|
| 528 | if (Sls.ne.0) then |
---|
| 529 | var3dls(x,y,n,1)=resultat/float(Sls) |
---|
| 530 | else |
---|
| 531 | var3dls(x,y,n,1)=missing |
---|
| 532 | endif |
---|
| 533 | enddo |
---|
| 534 | else ! average = n |
---|
| 535 | call interpolf(timels(n),resultat,lsgcm,var3dxy,timelen) |
---|
| 536 | var3dls(x,y,n,1)=resultat |
---|
| 537 | endif |
---|
[137] | 538 | enddo |
---|
| 539 | enddo |
---|
| 540 | enddo |
---|
| 541 | ! 3D variable (lon, lat, alt, time) |
---|
| 542 | ! interpolation of var at timels |
---|
| 543 | else if (ndim==4) then |
---|
| 544 | do x=1,lonlen |
---|
| 545 | do y=1,latlen |
---|
| 546 | do k=1,altlen |
---|
| 547 | do l=1,timelen |
---|
| 548 | var3dxy(l)=var3d(x,y,k,l) |
---|
| 549 | enddo |
---|
[1409] | 550 | do n=1,Nls |
---|
| 551 | if(average.eq.'y') then |
---|
| 552 | resultat=0. |
---|
| 553 | Sls=0 ! (gcm data counter within each Ls timestep) |
---|
| 554 | do l=1,timelen |
---|
| 555 | if((lsgcm(l).ge.(timels(n)-deltals/2.)).and. & |
---|
| 556 | (lsgcm(l).lt.(timels(n)+deltals/2.))) then |
---|
| 557 | if(var3dxy(l) .ne. missing) then |
---|
| 558 | Sls= Sls +1 |
---|
| 559 | resultat = resultat + var3dxy(l) |
---|
| 560 | end if |
---|
| 561 | end if |
---|
| 562 | if (Sls.ne.0) then |
---|
| 563 | var3dls(x,y,k,n)=resultat/float(Sls) |
---|
| 564 | else |
---|
| 565 | var3dls(x,y,k,n)=missing |
---|
| 566 | endif |
---|
| 567 | enddo |
---|
| 568 | else ! average = n |
---|
| 569 | call interpolf(timels(n),resultat,lsgcm,var3dxy,timelen) |
---|
| 570 | var3dls(x,y,k,n)=resultat |
---|
| 571 | end if |
---|
[137] | 572 | enddo |
---|
| 573 | enddo |
---|
| 574 | enddo |
---|
| 575 | enddo |
---|
| 576 | endif |
---|
| 577 | |
---|
| 578 | !============================================================================== |
---|
[1409] | 579 | ! 3.7 Write variable to output file |
---|
[137] | 580 | !============================================================================== |
---|
| 581 | |
---|
| 582 | |
---|
| 583 | |
---|
| 584 | |
---|
| 585 | ierr= NF_PUT_VARA_REAL(nout,varidout,corner,edges,var3dls) |
---|
| 586 | |
---|
| 587 | |
---|
| 588 | if (ierr.ne.NF_NOERR) then |
---|
| 589 | write(*,*) 'PUT_VAR ERROR: ',NF_STRERROR(ierr) |
---|
| 590 | stop "" |
---|
| 591 | endif |
---|
| 592 | |
---|
[1409] | 593 | ! In case there is a "missing value" attribute and "valid range" |
---|
| 594 | if (miss.eq.NF_NOERR) then |
---|
| 595 | call missing_value(nout,varidout,valid_range,missing) |
---|
| 596 | end if |
---|
| 597 | |
---|
[137] | 598 | deallocate(var3d) |
---|
| 599 | deallocate(var3dls) |
---|
| 600 | deallocate(var3dxy) |
---|
| 601 | |
---|
| 602 | enddo ! of do j=1,nbvar loop |
---|
| 603 | |
---|
| 604 | deallocate(time) |
---|
| 605 | deallocate(lsgcm) |
---|
| 606 | |
---|
| 607 | ! close input and output files |
---|
| 608 | ierr=nf_close(nid) |
---|
| 609 | ierr=NF_CLOSE(nout) |
---|
| 610 | |
---|
| 611 | |
---|
| 612 | !============================================================================== |
---|
| 613 | ! 4. Build a companion file 'lslin.ctl', so that output file can be |
---|
| 614 | ! processed by Grads |
---|
| 615 | !============================================================================== |
---|
| 616 | |
---|
| 617 | ! ---------------------------------------------------- |
---|
| 618 | ! Writing ctl file to directly read Ls coordinate in grads |
---|
| 619 | ! (because of bug in grads that refuse to read date like 0089 in .nc files) |
---|
| 620 | !open(33,file='lslin.ctl') |
---|
| 621 | open(33,file=infile(1:len_trim(infile)-3)//"_Ls.ctl") |
---|
| 622 | date= (timels(1)-int(timels(1)))*365. |
---|
| 623 | mon='jan' |
---|
| 624 | if(date.ge.32) mon='feb' |
---|
| 625 | if(date.ge.60) mon='mar' |
---|
| 626 | if(date.ge.91) mon='apr' |
---|
| 627 | if(date.ge.121) mon='may' |
---|
| 628 | if(date.ge.152) mon='jun' |
---|
| 629 | if(date.ge.182) mon='jul' |
---|
| 630 | if(date.ge.213) mon='aug' |
---|
| 631 | if(date.ge.244) mon='sep' |
---|
| 632 | if(date.ge.274) mon='oct' |
---|
| 633 | if(date.ge.305) mon='nov' |
---|
| 634 | if(date.ge.335) mon='dec' |
---|
[1409] | 635 | write(33,98) "^"//outfile |
---|
[137] | 636 | 98 format("DSET ",a) |
---|
| 637 | write(33,99) Nls, 15,mon, int(timels(1)),nint(deltals*12),'mo' |
---|
| 638 | 99 format("TDEF Time ",i5," LINEAR ", i2,a3,i4.4,1x,i2,a2) |
---|
| 639 | |
---|
| 640 | deallocate(timels) |
---|
| 641 | contains |
---|
| 642 | |
---|
| 643 | !************************************ |
---|
| 644 | subroutine initiate (filename,lat,lon,alt,& |
---|
[1409] | 645 | nout,latdimout,londimout,altdimout,timedimout,timevarout,units_alt) |
---|
[137] | 646 | !============================================================================== |
---|
| 647 | ! Purpose: |
---|
| 648 | ! Create and initialize a data file (NetCDF format) |
---|
| 649 | !============================================================================== |
---|
| 650 | ! Remarks: |
---|
| 651 | ! The NetCDF file (created in this subroutine) remains open |
---|
| 652 | !============================================================================== |
---|
| 653 | |
---|
| 654 | implicit none |
---|
| 655 | |
---|
| 656 | include "netcdf.inc" ! NetCDF definitions |
---|
| 657 | |
---|
| 658 | !============================================================================== |
---|
| 659 | ! Arguments: |
---|
| 660 | !============================================================================== |
---|
| 661 | character (len=*), intent(in):: filename |
---|
| 662 | ! filename(): the file's name |
---|
| 663 | real, dimension(:), intent(in):: lat |
---|
| 664 | ! lat(): latitude |
---|
| 665 | real, dimension(:), intent(in):: lon |
---|
| 666 | ! lon(): longitude |
---|
| 667 | real, dimension(:), intent(in):: alt |
---|
| 668 | ! alt(): altitude |
---|
| 669 | integer, intent(out):: nout |
---|
| 670 | ! nout: [netcdf] file ID |
---|
| 671 | integer, intent(out):: latdimout |
---|
| 672 | ! latdimout: [netcdf] lat() (i.e.: latitude) ID |
---|
| 673 | integer, intent(out):: londimout |
---|
| 674 | ! londimout: [netcdf] lon() ID |
---|
| 675 | integer, intent(out):: altdimout |
---|
| 676 | ! altdimout: [netcdf] alt() ID |
---|
| 677 | integer, intent(out):: timedimout |
---|
| 678 | ! timedimout: [netcdf] "Time" ID |
---|
| 679 | integer, intent(out):: timevarout |
---|
| 680 | ! timevarout: [netcdf] "Time" (considered as a variable) ID |
---|
[1409] | 681 | character (len=50) :: units_alt |
---|
| 682 | ! var(): units of altitude which can be m or Pa (after zrecast) |
---|
[137] | 683 | |
---|
[1409] | 684 | |
---|
[137] | 685 | !============================================================================== |
---|
| 686 | ! Local variables: |
---|
| 687 | !============================================================================== |
---|
| 688 | !integer :: latdim,londim,altdim,timedim |
---|
| 689 | integer :: nvarid,ierr |
---|
| 690 | ! nvarid: [netcdf] ID of a variable |
---|
| 691 | ! ierr: [netcdf] return error code (from called subroutines) |
---|
| 692 | |
---|
| 693 | !============================================================================== |
---|
| 694 | ! 1. Create (and open) output file |
---|
| 695 | !============================================================================== |
---|
| 696 | write(*,*) "creating "//trim(adjustl(filename))//'...' |
---|
[410] | 697 | ierr = NF_CREATE(filename,IOR(NF_CLOBBER,NF_64BIT_OFFSET),nout) |
---|
[137] | 698 | ! NB: setting NF_CLOBBER mode means that it's OK to overwrite an existing file |
---|
| 699 | if (ierr.NE.NF_NOERR) then |
---|
| 700 | WRITE(*,*)'ERROR: Impossible to create the file.' |
---|
| 701 | stop "" |
---|
| 702 | endif |
---|
| 703 | |
---|
| 704 | !============================================================================== |
---|
| 705 | ! 2. Define/write "dimensions" and get their IDs |
---|
| 706 | !============================================================================== |
---|
| 707 | |
---|
| 708 | ierr = NF_DEF_DIM(nout, "latitude", size(lat), latdimout) |
---|
| 709 | ierr = NF_DEF_DIM(nout, "longitude", size(lon), londimout) |
---|
| 710 | ierr = NF_DEF_DIM(nout, "altitude", size(alt), altdimout) |
---|
| 711 | ierr = NF_DEF_DIM(nout, "Time", NF_UNLIMITED, timedimout) |
---|
| 712 | |
---|
| 713 | ! End netcdf define mode |
---|
| 714 | ierr = NF_ENDDEF(nout) |
---|
| 715 | |
---|
| 716 | !============================================================================== |
---|
| 717 | ! 3. Write "Time" and its attributes |
---|
| 718 | !============================================================================== |
---|
| 719 | |
---|
| 720 | call def_var(nout,"Time","Time","years since 0000-00-0 00:00:00",1,& |
---|
| 721 | (/timedimout/),timevarout,ierr) |
---|
| 722 | |
---|
| 723 | !============================================================================== |
---|
| 724 | ! 4. Write "latitude" (data and attributes) |
---|
| 725 | !============================================================================== |
---|
| 726 | |
---|
| 727 | call def_var(nout,"latitude","latitude","degrees_north",1,& |
---|
| 728 | (/latdimout/),nvarid,ierr) |
---|
| 729 | |
---|
| 730 | ierr = NF_PUT_VAR_REAL (nout,nvarid,lat) |
---|
| 731 | |
---|
| 732 | !============================================================================== |
---|
| 733 | ! 4. Write "longitude" (data and attributes) |
---|
| 734 | !============================================================================== |
---|
| 735 | |
---|
| 736 | call def_var(nout,"longitude","East longitude","degrees_east",1,& |
---|
| 737 | (/londimout/),nvarid,ierr) |
---|
| 738 | |
---|
| 739 | ierr = NF_PUT_VAR_REAL (nout,nvarid,lon) |
---|
| 740 | |
---|
| 741 | !============================================================================== |
---|
| 742 | ! 4. Write "altitude" (data and attributes) |
---|
| 743 | !============================================================================== |
---|
| 744 | |
---|
| 745 | ! Switch to netcdf define mode |
---|
| 746 | ierr = NF_REDEF (nout) |
---|
| 747 | |
---|
| 748 | ierr = NF_DEF_VAR (nout,"altitude",NF_FLOAT,1,altdimout,nvarid) |
---|
| 749 | |
---|
| 750 | ierr = NF_PUT_ATT_TEXT (nout,nvarid,"long_name",8,"altitude") |
---|
[1409] | 751 | !********************* temlporaire **************** |
---|
| 752 | !ierr = NF_PUT_ATT_TEXT (nout,nvarid,'units',2,units_alt) |
---|
| 753 | !if((units_alt(1:2).eq.'Pa').or.(units_alt(1:2).eq.'pa')) then |
---|
| 754 | ! ierr = NF_PUT_ATT_TEXT (nout,nvarid,'positive',2,"down") |
---|
| 755 | !else |
---|
| 756 | ! ierr = NF_PUT_ATT_TEXT (nout,nvarid,'positive',2,"up") |
---|
| 757 | !end if |
---|
| 758 | !********************* temlporaire **************** |
---|
| 759 | ierr = NF_PUT_ATT_TEXT (nout,nvarid,'units',2,'Pa') |
---|
| 760 | ierr = NF_PUT_ATT_TEXT (nout,nvarid,'positive',4,'down') |
---|
| 761 | !********************* temlporaire **************** |
---|
[137] | 762 | |
---|
| 763 | ! End netcdf define mode |
---|
| 764 | ierr = NF_ENDDEF(nout) |
---|
| 765 | |
---|
| 766 | ierr = NF_PUT_VAR_REAL (nout,nvarid,alt) |
---|
| 767 | |
---|
| 768 | end Subroutine initiate |
---|
| 769 | !************************************ |
---|
| 770 | subroutine def_var(nid,name,title,units,nbdim,dim,nvarid,ierr) |
---|
| 771 | !============================================================================== |
---|
| 772 | ! Purpose: Write a variable (i.e: add a variable to a dataset) |
---|
| 773 | ! called "name"; along with its attributes "title", "units"... |
---|
| 774 | ! to a file (following the NetCDF format) |
---|
| 775 | !============================================================================== |
---|
| 776 | ! Remarks: |
---|
| 777 | ! The NetCDF file must be open |
---|
| 778 | !============================================================================== |
---|
| 779 | |
---|
| 780 | implicit none |
---|
| 781 | |
---|
| 782 | include "netcdf.inc" ! NetCDF definitions |
---|
| 783 | |
---|
| 784 | !============================================================================== |
---|
| 785 | ! Arguments: |
---|
| 786 | !============================================================================== |
---|
| 787 | integer, intent(in) :: nid |
---|
| 788 | ! nid: [netcdf] file ID # |
---|
| 789 | character (len=*), intent(in) :: name |
---|
| 790 | ! name(): [netcdf] variable's name |
---|
| 791 | character (len=*), intent(in) :: title |
---|
| 792 | ! title(): [netcdf] variable's "title" attribute |
---|
| 793 | character (len=*), intent(in) :: units |
---|
| 794 | ! unit(): [netcdf] variable's "units" attribute |
---|
| 795 | integer, intent(in) :: nbdim |
---|
| 796 | ! nbdim: number of dimensions of the variable |
---|
| 797 | integer, dimension(nbdim), intent(in) :: dim |
---|
| 798 | ! dim(nbdim): [netcdf] dimension(s) ID(s) |
---|
| 799 | integer, intent(out) :: nvarid |
---|
| 800 | ! nvarid: [netcdf] ID # of the variable |
---|
| 801 | integer, intent(out) :: ierr |
---|
| 802 | ! ierr: [netcdf] subroutines returned error code |
---|
| 803 | |
---|
| 804 | ! Switch to netcdf define mode |
---|
| 805 | ierr=NF_REDEF(nid) |
---|
| 806 | |
---|
| 807 | ! Insert the definition of the variable |
---|
| 808 | ierr=NF_DEF_VAR(nid,adjustl(name),NF_FLOAT,nbdim,dim,nvarid) |
---|
| 809 | |
---|
| 810 | ! Write the attributes |
---|
| 811 | ierr=NF_PUT_ATT_TEXT(nid,nvarid,"title",len_trim(adjustl(title)),adjustl(title)) |
---|
| 812 | ierr=NF_PUT_ATT_TEXT(nid,nvarid,"units",len_trim(adjustl(units)),adjustl(units)) |
---|
| 813 | |
---|
| 814 | ! End netcdf define mode |
---|
| 815 | ierr=NF_ENDDEF(nid) |
---|
| 816 | |
---|
| 817 | end subroutine def_var |
---|
| 818 | !************************************ |
---|
| 819 | subroutine sol2ls(sol,Ls) |
---|
| 820 | !============================================================================== |
---|
| 821 | ! Purpose: |
---|
| 822 | ! Convert a date/time, given in sol (martian day), |
---|
| 823 | ! into solar longitude date/time, in Ls (in degrees), |
---|
| 824 | ! where sol=0 is (by definition) the northern hemisphere |
---|
| 825 | ! spring equinox (where Ls=0). |
---|
| 826 | !============================================================================== |
---|
| 827 | ! Notes: |
---|
| 828 | ! Even though "Ls" is cyclic, if "sol" is greater than N (martian) year, |
---|
| 829 | ! "Ls" will be increased by N*360 |
---|
| 830 | ! Won't work as expected if sol is negative (then again, |
---|
| 831 | ! why would that ever happen?) |
---|
| 832 | !============================================================================== |
---|
| 833 | |
---|
| 834 | implicit none |
---|
| 835 | |
---|
| 836 | !============================================================================== |
---|
| 837 | ! Arguments: |
---|
| 838 | !============================================================================== |
---|
| 839 | real,intent(in) :: sol |
---|
| 840 | real,intent(out) :: Ls |
---|
| 841 | |
---|
| 842 | !============================================================================== |
---|
| 843 | ! Local variables: |
---|
| 844 | !============================================================================== |
---|
| 845 | real year_day,peri_day,timeperi,e_elips,twopi,degrad |
---|
| 846 | data year_day /669./ ! # of sols in a martian year |
---|
| 847 | data peri_day /485.0/ |
---|
[1409] | 848 | data timeperi /1.9082314/! True anomaly at vernal equinox = 2*PI-Lsperi |
---|
[137] | 849 | data e_elips /0.093358/ |
---|
| 850 | data twopi /6.2831853/ ! 2.*pi |
---|
| 851 | data degrad /57.2957795/ ! pi/180 |
---|
| 852 | |
---|
| 853 | real zanom,xref,zx0,zdx,zteta,zz |
---|
| 854 | |
---|
| 855 | integer count_years |
---|
| 856 | integer iter |
---|
| 857 | |
---|
| 858 | !============================================================================== |
---|
| 859 | ! 1. Compute Ls |
---|
| 860 | !============================================================================== |
---|
| 861 | |
---|
| 862 | zz=(sol-peri_day)/year_day |
---|
| 863 | zanom=twopi*(zz-nint(zz)) |
---|
| 864 | xref=abs(zanom) |
---|
| 865 | |
---|
| 866 | ! The equation zx0 - e * sin (zx0) = xref, solved by Newton |
---|
| 867 | zx0=xref+e_elips*sin(xref) |
---|
| 868 | do iter=1,20 ! typically, 2 or 3 iterations are enough |
---|
| 869 | zdx=-(zx0-e_elips*sin(zx0)-xref)/(1.-e_elips*cos(zx0)) |
---|
| 870 | zx0=zx0+zdx |
---|
| 871 | if(abs(zdx).le.(1.e-7)) then |
---|
| 872 | ! write(*,*)'iter:',iter,' |zdx|:',abs(zdx) |
---|
| 873 | exit |
---|
| 874 | endif |
---|
| 875 | enddo |
---|
| 876 | |
---|
| 877 | if(zanom.lt.0.) zx0=-zx0 |
---|
| 878 | |
---|
| 879 | zteta=2.*atan(sqrt((1.+e_elips)/(1.-e_elips))*tan(zx0/2.)) |
---|
| 880 | Ls=zteta-timeperi |
---|
| 881 | |
---|
| 882 | if(Ls.lt.0.) then |
---|
| 883 | Ls=Ls+twopi |
---|
| 884 | else |
---|
| 885 | if(Ls.gt.twopi) then |
---|
| 886 | Ls=Ls-twopi |
---|
| 887 | endif |
---|
| 888 | endif |
---|
| 889 | |
---|
| 890 | Ls=degrad*Ls |
---|
| 891 | ! Ls is now in degrees |
---|
| 892 | |
---|
| 893 | !============================================================================== |
---|
| 894 | ! 1. Account for (eventual) years included in input date/time sol |
---|
| 895 | !============================================================================== |
---|
| 896 | |
---|
| 897 | count_years=0 ! initialize |
---|
| 898 | zz=sol ! use "zz" to store (and work on) the value of sol |
---|
| 899 | do while (zz.ge.year_day) |
---|
| 900 | count_years=count_years+1 |
---|
| 901 | zz=zz-year_day |
---|
| 902 | enddo |
---|
| 903 | |
---|
| 904 | ! Add 360 degrees to Ls for every year |
---|
| 905 | if (count_years.ne.0) then |
---|
| 906 | Ls=Ls+360.*count_years |
---|
| 907 | endif |
---|
| 908 | |
---|
| 909 | |
---|
| 910 | end subroutine sol2ls |
---|
| 911 | !************************************ |
---|
| 912 | |
---|
| 913 | Subroutine interpolf(x,y,xd,yd,nd) |
---|
| 914 | !interpolation, give y = f(x) with array xd,yd known, size nd |
---|
| 915 | ! Version with CONSTANT values oustide limits |
---|
| 916 | ! Variable declaration |
---|
| 917 | ! -------------------- |
---|
| 918 | ! Arguments : |
---|
| 919 | real x,y |
---|
| 920 | real xd(*),yd(*) |
---|
| 921 | integer nd |
---|
| 922 | ! internal |
---|
| 923 | integer i,j |
---|
| 924 | real y_undefined |
---|
| 925 | |
---|
| 926 | ! run |
---|
| 927 | ! --- |
---|
| 928 | y_undefined=1.e20 |
---|
| 929 | |
---|
| 930 | y=0. |
---|
| 931 | if ((x.le.xd(1)).and.(x.le.xd(nd))) then |
---|
| 932 | if (xd(1).lt.xd(nd)) y = yd(1) !y_undefined |
---|
| 933 | if (xd(1).ge.xd(nd)) y = y_undefined ! yd(nd) |
---|
| 934 | else if ((x.ge.xd(1)).and.(x.ge.xd(nd))) then |
---|
| 935 | if (xd(1).lt.xd(nd)) y = y_undefined ! yd(nd) |
---|
| 936 | if (xd(1).ge.xd(nd)) y = y_undefined ! yd(1) |
---|
| 937 | y = yd(nd) |
---|
| 938 | else |
---|
| 939 | do i=1,nd-1 |
---|
| 940 | if ( ( (x.ge.xd(i)).and.(x.lt.xd(i+1)) ).or.((x.le.xd(i)).and.(x.gt.xd(i+1))) ) then |
---|
| 941 | y=yd(i)+(x-xd(i))*(yd(i+1)-yd(i))/(xd(i+1)-xd(i)) |
---|
| 942 | goto 99 |
---|
| 943 | end if |
---|
| 944 | end do |
---|
| 945 | end if |
---|
| 946 | |
---|
| 947 | ! write (*,*)' x , y' , x,y |
---|
| 948 | ! do i=1,nd |
---|
| 949 | ! write (*,*)' i, xd , yd' ,i, xd(i),yd(i) |
---|
| 950 | ! end do |
---|
| 951 | ! stop |
---|
| 952 | |
---|
| 953 | 99 continue |
---|
| 954 | |
---|
| 955 | end subroutine interpolf |
---|
| 956 | |
---|
| 957 | end |
---|
[1409] | 958 | |
---|
| 959 | |
---|
| 960 | |
---|
| 961 | !****************************************************************************** |
---|
| 962 | !****************************************************************************** |
---|
| 963 | subroutine missing_value(nout,nvarid,valid_range,missing) |
---|
| 964 | !============================================================================== |
---|
| 965 | ! Purpose: |
---|
| 966 | ! Write "valid_range" and "missing_value" attributes (of a given |
---|
| 967 | ! variable) to a netcdf file |
---|
| 968 | !============================================================================== |
---|
| 969 | ! Remarks: |
---|
| 970 | ! NetCDF file must be open |
---|
| 971 | ! Variable (nvarid) ID must be set |
---|
| 972 | !============================================================================== |
---|
| 973 | |
---|
| 974 | implicit none |
---|
| 975 | |
---|
| 976 | include "netcdf.inc" ! NetCDF definitions |
---|
| 977 | |
---|
| 978 | !============================================================================== |
---|
| 979 | ! Arguments: |
---|
| 980 | !============================================================================== |
---|
| 981 | integer, intent(in) :: nout |
---|
| 982 | ! nout: [netcdf] file ID # |
---|
| 983 | integer, intent(in) :: nvarid |
---|
| 984 | ! varid: [netcdf] variable ID # |
---|
| 985 | real, dimension(2), intent(in) :: valid_range |
---|
| 986 | ! valid_range(2): [netcdf] "valid_range" attribute (min and max) |
---|
| 987 | real, intent(in) :: missing |
---|
| 988 | ! missing: [netcdf] "missing_value" attribute |
---|
| 989 | |
---|
| 990 | !============================================================================== |
---|
| 991 | ! Local variables: |
---|
| 992 | !============================================================================== |
---|
| 993 | integer :: ierr |
---|
| 994 | ! ierr: [netcdf] subroutine returned error code |
---|
| 995 | ! INTEGER nout,nvarid,ierr |
---|
| 996 | ! REAL missing |
---|
| 997 | ! REAL valid_range(2) |
---|
| 998 | |
---|
| 999 | ! Switch to netcdf dataset define mode |
---|
| 1000 | ierr = NF_REDEF (nout) |
---|
| 1001 | if (ierr.ne.NF_NOERR) then |
---|
| 1002 | print*,'missing_value: ' |
---|
| 1003 | print*, NF_STRERROR(ierr) |
---|
| 1004 | endif |
---|
| 1005 | |
---|
| 1006 | ! Write valid_range() attribute |
---|
| 1007 | #ifdef NC_DOUBLE |
---|
| 1008 | ierr=NF_PUT_ATT_DOUBLE(nout,nvarid,'valid_range',NF_DOUBLE,2,valid_range) |
---|
| 1009 | #else |
---|
| 1010 | ierr=NF_PUT_ATT_REAL(nout,nvarid,'valid_range',NF_FLOAT,2,valid_range) |
---|
| 1011 | #endif |
---|
| 1012 | |
---|
| 1013 | if (ierr.ne.NF_NOERR) then |
---|
| 1014 | print*,'missing_value: valid_range attribution failed' |
---|
| 1015 | print*, NF_STRERROR(ierr) |
---|
| 1016 | !write(*,*) 'NF_NOERR', NF_NOERR |
---|
| 1017 | !CALL abort |
---|
| 1018 | stop "" |
---|
| 1019 | endif |
---|
| 1020 | |
---|
| 1021 | ! Write "missing_value" attribute |
---|
| 1022 | #ifdef NC_DOUBLE |
---|
| 1023 | ierr= NF_PUT_ATT_DOUBLE(nout,nvarid,'missing_value',NF_DOUBLE,1,missing) |
---|
| 1024 | #else |
---|
| 1025 | ierr= NF_PUT_ATT_REAL(nout,nvarid,'missing_value',NF_FLOAT,1,missing) |
---|
| 1026 | #endif |
---|
| 1027 | |
---|
| 1028 | if (ierr.NE.NF_NOERR) then |
---|
| 1029 | print*, 'missing_value: missing value attribution failed' |
---|
| 1030 | print*, NF_STRERROR(ierr) |
---|
| 1031 | ! WRITE(*,*) 'NF_NOERR', NF_NOERR |
---|
| 1032 | ! CALL abort |
---|
| 1033 | stop "" |
---|
| 1034 | endif |
---|
| 1035 | |
---|
| 1036 | ! End netcdf dataset define mode |
---|
| 1037 | ierr = NF_ENDDEF(nout) |
---|
| 1038 | |
---|
| 1039 | end subroutine missing_value |
---|
| 1040 | !****************************************************************************** |
---|