source: trunk/LMDZ.VENUS/Tools/startarchive2icosa/rearrange_startphy.f90 @ 3590

PROGRAM rearrange_startphy

USE netcdf

IMPLICIT NONE

INTEGER :: ncid
INTEGER :: dimids(4)
INTEGER :: varid
INTEGER :: ierr
INTEGER :: nvar
INTEGER :: ndim
CHARACTER(LEN=100) :: varname
INTEGER :: varname_dimids(4)

INTEGER :: i,j,k,nb_cells
INTEGER,ALLOCATABLE :: cell_index(:)
REAL,ALLOCATABLE :: ref_lon(:)
REAL,ALLOCATABLE :: ref_lat(:)
REAL,ALLOCATABLE :: lon(:)
REAL,ALLOCATABLE :: lat(:)
REAL,ALLOCATABLE :: ref_field(:),field(:)
REAL :: lati,loni
REAL :: diff_lat,diff_lon
CHARACTER(LEN=*),PARAMETER :: ref_file="startphy_icosa_ref.nc"
CHARACTER(LEN=*),PARAMETER :: file="startphy_icosa.nc"

! load coordinates from files
  ierr=NF90_OPEN(ref_file, NF90_NOWRITE, ncid)
  ierr=NF90_INQ_DIMID(ncid,"points_physiques",dimids(1))
  ierr=NF90_INQUIRE_DIMENSION(ncid, dimids(1), len=nb_cells)
  write(*,*) "nb_cells=",nb_cells,"dimids(1)=",dimids(1)
  allocate(ref_lat(nb_cells),ref_lon(nb_cells))
  
  ierr=NF90_INQ_VARID(ncid,"latitude",varid)
  ierr=NF90_GET_VAR(ncid,varid,ref_lat)
  if (ierr /= nf90_noerr) then
    write(*,*) "cannot load latitude from ",trim(ref_file)
  else
    write(*,*) "ref_lat(1:5)=",ref_lat(1:5)
  endif
  ierr=NF90_INQ_VARID(ncid,"longitude",varid)
  ierr=NF90_GET_VAR(ncid,varid,ref_lon)
  if (ierr /= nf90_noerr) then
    write(*,*) "cannot load longitude from ",trim(ref_file)
  else
    write(*,*) "ref_lon(1:5)=",ref_lon(1:5)
  endif
  ierr=NF90_CLOSE(ncid)
  
  ierr=NF90_OPEN(file, NF90_WRITE, ncid)
  allocate(lat(nb_cells),lon(nb_cells))
  ierr=NF90_INQ_VARID(ncid,"lat",varid)
  ierr=NF90_GET_VAR(ncid,varid,lat)
  if (ierr /= nf90_noerr) then
    write(*,*) "cannot load lat from ",trim(file)
  else
    write(*,*) "lat(1:5)=",lat(1:5)
  endif
  ierr=NF90_INQ_VARID(ncid,"lon",varid)
  ierr=NF90_GET_VAR(ncid,varid,lon)
  if (ierr /= nf90_noerr) then
    write(*,*) "cannot load lat from ",trim(file)
  else
    write(*,*) "lon(1:5)=",lon(1:5)
  endif
  
  ! find correspondances between lon/ref_lon & lat/ref_lat
  allocate(cell_index(nb_cells))
  cell_index(:)=0
  do i=1,nb_cells
    lati=lat(i) ; loni=lon(i)
    do j=1,nb_cells
     if (lati/=0) then ! use relative difference, if possible
       diff_lat=abs((lati-ref_lat(j))/lati)
     else
       diff_lat=abs(lati-ref_lat(j))
     endif
     if (loni/=0) then ! use relative difference, if possible
       diff_lon=abs((loni-ref_lon(j))/loni)
     else
       diff_lon=abs(loni-ref_lon(j))
     endif
     
     if ((diff_lat <= 1.e-6).and.(diff_lon <= 1.e-6)) then
      cell_index(i)=j
      write(*,*)"j=",j," lati=",lati," ref_lat(j)=",ref_lat(j)
      write(*,*)"j=",j," loni=",loni," ref_lon(j)=",ref_lon(j)
     endif
    enddo ! of do j=1,nb_cells
    write(*,*) ">> i=",i,"cell_index(i)=",cell_index(i)

    ! sanity check:
    if (cell_index(i)==0) then
      write(*,*) "Error, could not find lon-lat match for i=",i
      write(*,*) "       lat(i)=",lat(i)," lon(i)=",lon(i)
      stop
    endif
  enddo ! of do i=1,nb_cells
  
!  do i=1,nb_cells
!    write(*,*) "i=",i," cell_index(i)=",cell_index(i)
!    write(*,*) "  lat(i)=",lat(i),"ref_lat(cell_index(i))=",ref_lat(cell_index(i))
!  enddo
  
  ! load, rearrange and write variables
  ierr=NF90_INQ_DIMID(ncid,"cell",dimids(1))
  ierr=NF90_INQUIRE(ncid,nVariables=nvar)
  write(*,*) "nvar=",nvar
  allocate(ref_field(nb_cells),field(nb_cells))
  ! loop over variables:
  do k=1,nvar
    ierr=NF90_INQUIRE_VARIABLE(ncid,k,name=varname,ndims=ndim,dimids=varname_dimids)
    if (ierr /= nf90_noerr) then
      write(*,*) "error for variable k=",k
      write(*,*) nf90_strerror(ierr)
    endif
    if ((ndim==1).and.(varname_dimids(1)==dimids(1))) then
      write(*,*) "processing ",trim(varname)
      ! load field
      ierr=NF90_INQ_VARID(ncid,varname,varid)
      ierr=NF90_GET_VAR(ncid,varid,ref_field)
      ! rearrange field
      do i=1,nb_cells
        field(cell_index(i))=ref_field(i)
      enddo
      ! write field
      ierr=NF90_PUT_VAR(ncid,varid,field)
    endif
  enddo
  
END PROGRAM rearrange_startphy