source: trunk/LMDZ.MARS/util/lslin.F90 @ 1073

Last change on this file since 1073 was 1073, checked in by tnavarro, 11 years ago

Better handling of the first date of the file : Read and write the controle field, if possible, for zrecast, localtime and concatnc + cosmetic change in lslin. This is retrocompatible with previous versions.

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