Changeset 2450 for trunk/LMDZ.MARS/util


Ignore:
Timestamp:
Jan 25, 2021, 8:03:25 PM (4 years ago)
Author:
abierjon
Message:

Mars GCM:
Changes in lslin.F90 :

  • make sure the interpolation takes into account potential missing values in the input file fields, especially when the average/binning option is not used (ticket #68)
  • enable the averaging option even when the Ls timestep is set automatically /!\ previous lslin.def must be updated in consequence !
  • code clean-up, especially remove duplicates on controle field and altitude units
  • replace all the tests "if (ndim.ge.3) then" by a unique test at the beginning of the var loop
  • change "title" attribute into "long_name" by default (ticket #48)

+ add an indicative updated lslin.def
+ update util/README

AB

Location:
trunk/LMDZ.MARS/util
Files:
1 added
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/LMDZ.MARS/util/README

    r2443 r2450  
    9090
    9191--------------------------------------------------------------------
    92 4) lslin.e : redistribute and AVERAGE gcm output in Ls coordinate.
    93 --------------------------------------------------------------------
    94 
    95 This program has been designed to interpol data in Solar Longitude (Ls)
     924) lslin.e : redistribute and average gcm output in Ls coordinate.
     93--------------------------------------------------------------------
     94
     95This program has been designed to interpolate data in Solar Longitude (Ls)
    9696linear time coordinate (usable with grads) from Netcdf diagfi or concatnc 
    97 files and to AVERAGE the instantaneous data in Ls period (for comparison with
    98 binned dataset, for instance).
     97files, and to average the instantaneous data in periodic Ls intervals
     98(for comparison with binned dataset, for instance).
    9999
    100100lslin also creates a lslin.ctl file that can be read
     
    103103is too small"...
    104104
    105 Output file is : name_of_input_file_LS.nc
     105Output file is : name_of_input_file_Ls.nc
    106106
    107107--------------------------------------------------------------------
  • trunk/LMDZ.MARS/util/lslin.F90

    r2432 r2450  
    2323character (len=50), dimension(:), allocatable :: var
    2424! var(): names of the variables
    25 character (len=50) :: title,units
    26 ! title(),units(): [netcdf] "title" and "units" attributes
    27 character (len=50) :: units_alt
    28 ! var(): units of altitude which can be 'km' or 'Pa' (after zrecast)
     25character (len=50) :: long_name,units
     26! long_name(),units(): [netcdf] "long_name" and "units" attributes
    2927character (len=50) :: altlong_name,altunits,altpositive
    3028! altlong_name(): [netcdf] altitude "long_name" attribute
     
    3735! vartmp(): used for temporary storage of various strings
    3836character (len=1) :: answer
    39 ! answer: the character 'y' (or 'Y'), if input file is of 'concatnc' type
     37! answer: user's answers at multiple questions (especially, answer='y'/'Y')
    4038character (len=1) :: average
    4139! average: the character 'y' to average within the Ls timestep
     
    5553integer :: day_ini ! Ehouarn: integer or real ?
    5654! day_ini: starting date/time of the run stored in input file
    57 integer, parameter :: length=100
    58 ! length: (default) lenght of tab_cntrl()
    59 real, dimension(length) :: tab_cntrl
    60 ! tab_cntrl(length): array, stored in the input file,
    61 !                which contains various control parameters.
    6255real, dimension(:), allocatable:: lat,lon,alt,time,lsgcm,timels,ctl
    6356! lat(): latitude coordinates (read from input file)
     
    129122read(*,'(a50)') infile
    130123
    131 !write(*,*) "Is it a concatnc file? (y/n)?"
    132 write(*,*) "Do you want to specify the beginning day of the file"
    133 write(*,*) "in case the controle field is not present ? (y/n)?"
    134 read(*,*) answer
    135 if ((answer=="y").or.(answer=="Y")) then
    136    write(*,*) "Beginning day of the file?"
    137    read(*,*) reptime
    138 !   start_var=8 ! 'concatnc' type of file
    139 !else
    140 !   start_var=16 ! 'diagfi' type of file
    141 ! N.B.: start_var is now computed; see below
    142 endif
    143 
    144 
    145124!==============================================================================
    146125! 1.2. Open input file and read/list the variables it contains
     
    178157ierr=NF_INQ_NVARS(nid,nbvarfile)
    179158! nbvarfile is now equal to the (total) number of variables in input file
    180 
    181 allocate(var(nbvarfile-(start_var-1)))
    182 
    183 ! Yield the list of variables (to the screen)
    184 write(*,*)
    185 do i=start_var,nbvarfile
    186    ierr=NF_INQ_VARNAME(nid,i,vartmp)
    187    write(*,*) trim(vartmp)
    188 enddo
    189 !nbvar=0
    190 
    191 ! Ehouarn: Redundant (and obsolete) lines ?
    192 !  nbvar=nbvarfile-(start_var-1)
    193 !  do j=start_var,nbvarfile
    194 !  ierr=nf_inq_varname(nid,j,var(j-(start_var-1)))
    195 !  enddo
    196159                                       
    197160! Get the variables' names from the input file (and store them in var())
     161write(*,*) ""
    198162nbvar=nbvarfile-(start_var-1)
     163allocate(var(nbvar))
    199164do i=1,nbvar
    200165   ierr=NF_INQ_VARNAME(nid,i+(start_var-1),var(i))
     
    205170! 1.3. Output file name
    206171!==============================================================================
    207 ! outfile="lslin.nc"
    208172outfile=infile(1:len_trim(infile)-3)//"_Ls.nc"
    209  write(*,*) outfile
     173write(*,*) ""
     174write(*,*) "Output file : "//trim(outfile)
    210175
    211176
     
    247212   else
    248213      ierr=NF_INQ_DIMLEN(nid,altdim,altlen)
    249       units_alt=""
    250       ierr=NF_GET_ATT_TEXT(nid,varid,"units",units_alt)
    251    endif
    252    write(*,*) "altlen: ",altlen
    253 ! Get altitude attributes to handle files with any altitude type
    254    ierr=nf_get_att_text(nid,altvar,'long_name',altlong_name)
    255    ierr=nf_get_att_text(nid,altvar,'units',altunits)
    256    ierr=nf_get_att_text(nid,altvar,'positive',altpositive)
     214     
     215    ! Get altitude attributes to handle files with any altitude type
     216      ierr=nf_get_att_text(nid,altvar,'long_name',altlong_name)
     217      ierr=nf_get_att_text(nid,altvar,'units',altunits)
     218      ierr=nf_get_att_text(nid,altvar,'positive',altpositive)
     219   endif
     220!   write(*,*) "altlen: ",altlen
    257221
    258222
    259223! Allocate lat(), lon() and alt()
    260       allocate(lat(latlen))
    261       allocate(lon(lonlen))
    262       allocate(alt(altlen))
     224   allocate(lat(latlen))
     225   allocate(lon(lonlen))
     226   allocate(alt(altlen))
    263227
    264228! Read lat(),lon() and alt() from input file
    265       ierr = NF_GET_VAR_REAL(nid,latvar,lat)
    266       ierr = NF_GET_VAR_REAL(nid,lonvar,lon)
    267       ierr = NF_GET_VAR_REAL(nid,altvar,alt)
    268       if (ierr.NE.NF_NOERR) then
    269           if (altlen.eq.1) alt(1)=0.
    270       end if
     229   ierr = NF_GET_VAR_REAL(nid,latvar,lat)
     230   ierr = NF_GET_VAR_REAL(nid,lonvar,lon)
     231   ierr = NF_GET_VAR_REAL(nid,altvar,alt)
     232   if (ierr.NE.NF_NOERR) then
     233       if (altlen.eq.1) alt(1)=0.
     234   end if
    271235
    272236
     
    304268
    305269!==============================================================================
    306 ! 2.2. Create (and initialize latitude, longitude and altitude in) output file
     270! 2.2. Create (and initialize) latitude, longitude and altitude in output file
    307271!==============================================================================
    308272
     
    316280              nout,londimout,latdimout,altdimout)
    317281
     282   write(*,*)""
    318283!==============================================================================
    319284! 2.3. Read time from input file
     
    339304allocate(lsgcm(timelen))
    340305
    341 
    342 
    343 
    344306ierr = NF_GET_VAR_REAL(nid,timevar,time)
    345307
    346 
    347308!==============================================================================
    348309! 2.4. Initialize day_ini (starting day of the run)
    349310!==============================================================================
    350311
    351 
    352 write(*,*) 'answer',answer
     312if (ctllen .ne. 0) then ! controle is present in input file
     313  write(*,*) "Do you want to specify the beginning day of the file (y/n) ?"
     314  write(*,*) "If 'n', the value stored in the controle field will be used."
     315  read(*,*) answer
     316else ! controle is not present in the input file
     317  write(*,*) "There is no field controle in file "//trim(infile)
     318  write(*,*) "You have to specify the beginning day of the file."
     319  answer="y"
     320endif
     321
     322if ((answer=="y").or.(answer=="Y")) then
     323   write(*,*) "Beginning day of the file?"
     324   read(*,*) reptime
     325endif
     326
     327write(*,*) 'answer : ',answer
    353328if ((answer/="y").and.(answer/="Y")) then
    354    ! input file is of 'concatnc' type; the starting date of the run
     329   ! the starting date of the run
    355330   ! is stored in the "controle" array
    356    ierr = NF_INQ_VARID (nid, "controle", varid)
    357    if (ierr .NE. NF_NOERR) then
    358       write(*,*) 'ERROR: <controle> variable is missing'
    359       write(*,*) NF_STRERROR(ierr)
    360       stop ""
    361    endif
    362 
    363 
    364 
    365 
    366    ierr = NF_GET_VAR_REAL(nid, varid, tab_cntrl)
    367 
    368 
    369    if (ierr .NE. NF_NOERR) then
    370       write(*,*) 'ERROR: Failed to read <controle>'
    371       write(*,*) NF_STRERROR(ierr)
    372      stop ""
    373    endif
    374 
    375    day_ini = nint(tab_cntrl(4))                                               
     331   
     332   day_ini = nint(ctl(4))                                               
    376333   day_ini = modulo(day_ini,669)                                                   
    377334   write(*,*) 'day_ini', day_ini
     
    397354write(*,*) 'Input data LS range :', lsgcm(1),lsgcm(timelen)
    398355
    399 !******************************************
    400 write(*,*) "Automatic Ls timetsep (y/n)?"
     356! generate the time step of the new Ls axis for the output
     357write(*,*) "Automatic Ls timestep (y/n)?"
    401358read(*,*) answer
    402359if ((answer=="y").or.(answer=="Y")) then
     
    417374    ls0=lsgcm(1) ! First Ls date
    418375else
    419     write(*,*) "New timestep in Ls (deg)"
     376    write(*,*) "New timestep in Ls (deg) :"
    420377    read(*,*) deltals
    421     write(*,*) "First Ls (deg)"
     378    write(*,*) "First Ls (deg) :"
    422379    read(*,*) ls0
    423380    if (ls0.lt.lsgcm(1)) then
     
    426383    end if
    427384    write(*,*) "First Ls date (deg) = ", ls0  ! FF2013
    428 
    429     do while((average.ne.'y').and.(average.ne.'n'))
    430        write(*,*) "Average data within the Ls timestep (y/n) or interpolate ? "
    431        read(*,*) average
    432     end do
    433 endif
    434   NLs=int(Int((lsgcm(timelen)-ls0)/deltals) +1)   ! FF2013
    435 !********************************************
     385endif
     386
     387NLs=int(int((lsgcm(timelen)-ls0)/deltals) +1)   ! FF2013
    436388allocate(timels(Nls))
    437389
    438390! Build timels()
    439 timels(1) = 0.01*nint(100.*ls0)
     391timels(1) = 0.01*nint(100.*ls0) ! 2 decimals
    440392do k=2,Nls
    441393   timels(k) = timels(k-1) + deltals
    442394end do
    443395
    444 write(*,*) 'timestep in Ls (deg) ', deltals
    445 write(*,*) 'output data LS range : ', timels(1),timels(Nls)
     396write(*,*) 'New timestep in Ls (deg) ', deltals
     397write(*,*) 'Output data LS range : ', timels(1),timels(Nls)
     398
     399! create averaged bins or interpolate at exact Ls ?
     400write(*,*) "Average data within the Ls timestep (y/n) or interpolate ? "
     401read(*,*) average
     402write(*,*)""
    446403
    447404!==============================================================================
     
    450407
    451408do k=1,Nls
    452 
    453 
    454 
    455 ierr= NF_PUT_VARA_REAL(nout,timevarout,k,1,timels(k))
    456 
     409  ierr= NF_PUT_VARA_REAL(nout,timevarout,k,1,timels(k))
    457410enddo
    458 
    459411
    460412!==============================================================================
     
    474426      write(*,*) 'ERROR: Field <',var(j),'> not found'
    475427      write(*,*) NF_STRERROR(ierr)
    476       stop ""
    477    endif
     428      stop "Better stop now..."
     429   endif
     430   
    478431   ! Get the value of 'ndim' for this varriable
    479432   ierr=NF_INQ_VARNDIMS(nid,varid,ndim)
    480433   write(*,*) 'ndim', ndim
     434   
     435   ! Check that it is a 3D or 4D variable
     436   if (ndim.lt.3) then
     437     write(*,*) "Error:",trim(var(j))," is neither a 3D nor a 4D variable"
     438     write(*,*) "We'll skip that variable..."
     439     CYCLE ! go directly to the next variable
     440   endif
    481441
    482442!==============================================================================
     
    527487! 3.3 Write this variable's definition and attributes to the output file
    528488!==============================================================================
    529    if (ndim.ge.3) then
    530     units=""
    531     title=""
    532     ierr=NF_GET_ATT_TEXT(nid,varid,"title",title)
    533     ierr=NF_GET_ATT_TEXT(nid,varid,"units",units)
    534 
    535     call def_var(nout,var(j),title,units,ndim,dim,varidout,ierr)
    536    end if
     489   units=" "
     490   long_name=" "
     491   ierr=nf_get_att_text(nid,varid,"long_name",long_name)
     492   if (ierr.ne.nf_noerr) then
     493   ! if no attribute "long_name", try "title"
     494     ierr=nf_get_att_text(nid,varid,"title",long_name)
     495   endif
     496   ierr=nf_get_att_text(nid,varid,"units",units)
     497
     498   call def_var(nout,var(j),long_name,units,ndim,dim,varidout,ierr)
    537499
    538500!==============================================================================
    539501! 3.4 Read variable
    540 !==== ==========================================================================
    541 
    542    if (ndim.ge.3) then
    543       ierr = NF_GET_VAR_REAL(nid,varid,var3d)
    544       miss=NF_GET_ATT_REAL(nid,varid,"missing_value",missing)
    545       validr=NF_GET_ATT_REAL(nid,varid,"valid_range",valid_range)
    546    end if
    547 
     502!==============================================================================
     503
     504   ierr = NF_GET_VAR_REAL(nid,varid,var3d)
     505   miss=NF_GET_ATT_REAL(nid,varid,"missing_value",missing)
     506   validr=NF_GET_ATT_REAL(nid,varid,"valid_range",valid_range)
    548507
    549508!==============================================================================
     
    578537               endif
    579538            enddo
    580           else   ! average = n
    581             call interpolf(timels(n),resultat,lsgcm,var3dxy,timelen)
     539          else   ! average = 'n'
     540            call interpolf(timels(n),resultat,missing,lsgcm,var3dxy,timelen)
    582541            var3dls(x,y,n,1)=resultat
    583542          endif
     
    612571               endif
    613572            enddo
    614           else   ! average = n
    615              call interpolf(timels(n),resultat,lsgcm,var3dxy,timelen)
     573          else   ! average = 'n'
     574             call interpolf(timels(n),resultat,missing,lsgcm,var3dxy,timelen)
    616575             var3dls(x,y,k,n)=resultat
    617           end if
     576          endif
    618577         enddo
    619578        enddo
     
    626585!==============================================================================
    627586
    628 
    629 
    630    if (ndim.ge.3) then
    631 
    632      ierr= NF_PUT_VARA_REAL(nout,varidout,corner,edges,var3dls)
    633 
    634 
    635      if (ierr.ne.NF_NOERR) then
    636       write(*,*) 'PUT_VAR ERROR: ',NF_STRERROR(ierr)
    637       stop ""
    638      endif
     587   ierr= NF_PUT_VARA_REAL(nout,varidout,corner,edges,var3dls)
     588
     589   if (ierr.ne.NF_NOERR) then
     590     write(*,*) 'PUT_VAR ERROR: ',NF_STRERROR(ierr)
     591     stop ""
     592   endif
    639593
    640594! In case there is a "missing value" attribute and "valid range"
    641      if (miss.eq.NF_NOERR) then
    642       call missing_value(nout,varidout,missing) 
    643      end if
    644 
    645      deallocate(var3d)
    646      deallocate(var3dls)
    647      deallocate(var3dxy)
    648    endif !  if (ndim.ge.3)
     595   if (miss.eq.NF_NOERR) then
     596     call missing_value(nout,varidout,missing) 
     597   endif
     598
     599   deallocate(var3d)
     600   deallocate(var3dls)
     601   deallocate(var3dxy)
    649602
    650603enddo ! of do j=1,nbvar loop
     
    666619!  Writing ctl file to directly read Ls coordinate in grads
    667620!  (because of bug in grads that refuse to read date like 0089 in .nc files)
    668 !open(33,file='lslin.ctl')
     621write(*,*)""
     622write(*,*) "Writing a controle file to directly read Ls coordinate with Grads..."
     623
    669624 open(33,file=infile(1:len_trim(infile)-3)//"_Ls.ctl")
    670625 date= (timels(1)-int(timels(1)))*365.
     
    68664199 format("TDEF Time ",i5," LINEAR ", i2,a3,i4.4,1x,i2,a2)
    687642   
    688    deallocate(timels)
     643deallocate(timels)
     644   
     645write(*,*)""   
     646write(*,*) "Program completed !"
     647
    689648contains
    690649
     
    876835   ierr = NF_DEF_VAR (nout,"controle",NF_FLOAT,1,ctldimout,nvarid)
    877836
    878    ierr = NF_PUT_ATT_TEXT (nout,nvarid,"title",18,"Control parameters")
     837   ierr = NF_PUT_ATT_TEXT (nout,nvarid,"long_name",18,"Control parameters")
    879838
    880839   ! End netcdf define mode
     
    10811040
    10821041!******************************************************************************
    1083 subroutine def_var(nid,name,title,units,nbdim,dim,nvarid,ierr)
     1042subroutine def_var(nid,name,long_name,units,nbdim,dim,nvarid,ierr)
    10841043!==============================================================================
    10851044! Purpose: Write a variable (i.e: add a variable to a dataset)
    1086 ! called "name"; along with its attributes "title", "units"...
     1045! called "name"; along with its attributes "long_name", "units"...
    10871046! to a file (following the NetCDF format)
    10881047!==============================================================================
     
    11021061character (len=*), intent(in) :: name
    11031062! name(): [netcdf] variable's name
    1104 character (len=*), intent(in) :: title
    1105 ! title(): [netcdf] variable's "title" attribute
     1063character (len=*), intent(in) :: long_name
     1064! long_name(): [netcdf] variable's "long_name" attribute
    11061065character (len=*), intent(in) :: units
    11071066! unit(): [netcdf] variable's "units" attribute
     
    11221081
    11231082! Write the attributes
    1124 ierr=NF_PUT_ATT_TEXT(nid,nvarid,"title",len_trim(adjustl(title)),adjustl(title))
     1083ierr=NF_PUT_ATT_TEXT(nid,nvarid,"long_name",len_trim(adjustl(long_name)),adjustl(long_name))
    11251084ierr=NF_PUT_ATT_TEXT(nid,nvarid,"units",len_trim(adjustl(units)),adjustl(units))
    11261085
     
    11821141!   print*,'missing_value: valid_range attribution failed'
    11831142!   print*, NF_STRERROR(ierr)
    1184 !   !write(*,*) 'NF_NOERR', NF_NOERR
    1185 !   !CALL abort
    11861143!   stop ""
    11871144!endif
     
    11931150   print*, 'missing_value: missing value attribution failed'
    11941151   print*, NF_STRERROR(ierr)
    1195 !    WRITE(*,*) 'NF_NOERR', NF_NOERR
    1196 !    CALL abort
    11971152   stop ""
    11981153endif
     
    12961251
    12971252end subroutine sol2ls
    1298 !************************************
    1299 
    1300 Subroutine interpolf(x,y,xd,yd,nd)
    1301 !interpolation, give y = f(x) with array xd,yd known, size nd
    1302 ! Version with CONSTANT values oustide limits
    1303 ! Variable declaration
    1304 ! --------------------
    1305 !  Arguments :
    1306 real x,y
    1307 real xd(*),yd(*)
    1308 integer nd
    1309 !  internal
    1310 integer i
    1311 real y_undefined
    1312                                                                                
    1313 ! run
    1314 ! ---
    1315       y_undefined=1.e20
    1316                                                                                
    1317       y=0.
    1318    if ((x.le.xd(1)).and.(x.le.xd(nd))) then
    1319     if (xd(1).lt.xd(nd)) y = yd(1) !y_undefined
    1320     if (xd(1).ge.xd(nd)) y = y_undefined ! yd(nd)
    1321    else if ((x.ge.xd(1)).and.(x.ge.xd(nd))) then
    1322     if (xd(1).lt.xd(nd)) y =  y_undefined ! yd(nd)
    1323     if (xd(1).ge.xd(nd)) y = y_undefined ! yd(1)
    1324     y = yd(nd)
    1325    else
    1326     do i=1,nd-1
    1327      if ( ( (x.ge.xd(i)).and.(x.lt.xd(i+1)) ).or.((x.le.xd(i)).and.(x.gt.xd(i+1))) ) then
    1328      y=yd(i)+(x-xd(i))*(yd(i+1)-yd(i))/(xd(i+1)-xd(i))
    1329      goto 99
    1330      end if
    1331     end do
    1332    end if
    1333 
    1334 !     write (*,*)' x , y' , x,y
    1335 !     do i=1,nd
    1336 !       write (*,*)' i, xd , yd' ,i, xd(i),yd(i)
    1337 !     end do
    1338 !     stop
    1339                                                                                
    1340 99   continue
    1341                                                                                
     1253
     1254!******************************************************************************
     1255subroutine interpolf(x,y,missing,xd,yd,nd)
     1256!==============================================================================
     1257! Purpose:
     1258! Yield y=f(x), where xd() end yd() are arrays of known values,
     1259! using linear interpolation
     1260! If x is not included in the interval spaned by xd(), then y is set
     1261! to a default value 'missing'
     1262! Note:
     1263! Array xd() should contain ordered (either increasing or decreasing) abscissas
     1264!==============================================================================
     1265implicit none
     1266!==============================================================================
     1267! Arguments:
     1268!==============================================================================
     1269real,intent(in) :: x ! abscissa at which interpolation is to be done
     1270real,intent(in) :: missing ! missing value (if no interpolation is performed)
     1271integer :: nd ! size of arrays
     1272real,dimension(nd),intent(in) :: xd ! array of known absissas
     1273real,dimension(nd),intent(in) :: yd ! array of correponding values
     1274
     1275real,intent(out) :: y ! interpolated value
     1276!==============================================================================
     1277! Local variables:
     1278!==============================================================================
     1279integer :: i
     1280
     1281! default: set y to 'missing'
     1282y=missing
     1283
     1284   do i=1,nd-1
     1285     if (((x.ge.xd(i)).and.(x.le.xd(i+1))).or.&
     1286          ((x.le.xd(i)).and.(x.ge.xd(i+1)))) then
     1287        if ((yd(i).eq.missing).or.(yd(i+1).eq.missing)) then
     1288          ! cannot perform the interpolation if an encompasing value
     1289          ! is already set to 'missing'
     1290        else
     1291          !linear interpolation based on encompassing values
     1292          y=yd(i)+(x-xd(i))*(yd(i+1)-yd(i))/(xd(i+1)-xd(i))
     1293        endif
     1294        exit
     1295     endif
     1296   enddo
     1297
     1298
    13421299end subroutine interpolf
    1343      
     1300
     1301!******************************************************************************
     1302
    13441303end program lslin
Note: See TracChangeset for help on using the changeset viewer.