read_surf Subroutine

public subroutine read_surf(nom_fic, mu, sq, tab_s, scal)

Note

Subroutine that opens a surface file .sur or .dat

The heights are centred, scaled then put into a vector.

Warning

If the scale factor sq is negative, the heights are not scaled when reading .sur

Warning

By default, the .sur header is dumped

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: nom_fic

file name

real(kind=R8), intent(in), optional :: mu

desired mean

real(kind=R8), intent(in), optional :: sq

desired height standard deviation

real(kind=R8), intent(out), dimension(:,:), allocatable :: tab_s

height array

type(SCALE_SURF), intent(out) :: scal

object SCALE_SURF


Calls

proc~~read_surf~2~~CallsGraph proc~read_surf~2 read_surf proc~get_unit~2 get_unit proc~read_surf~2->proc~get_unit~2 proc~lower lower proc~read_surf~2->proc~lower proc~open_surffile open_surffile proc~read_surf~2->proc~open_surffile proc~sort_array2 sort_array2 proc~read_surf~2->proc~sort_array2 proc~trans_surf_tab trans_surf_tab proc~read_surf~2->proc~trans_surf_tab proc~open_surffile->proc~get_unit~2 proc~surf2scal surf2scal proc~open_surffile->proc~surf2scal proc~trans_surf_txt trans_surf_txt proc~open_surffile->proc~trans_surf_txt proc~change_array_order change_array_order proc~sort_array2->proc~change_array_order proc~init_order init_order proc~sort_array2->proc~init_order proc~sort_array_integer_with_order sort_array_integer_with_order proc~sort_array2->proc~sort_array_integer_with_order proc~sort_array_real_with_order sort_array_real_with_order proc~sort_array2->proc~sort_array_real_with_order proc~unit2iuc unit2IUc proc~trans_surf_tab->proc~unit2iuc proc~sort_array_integer_with_order->proc~sort_array_integer_with_order proc~sort_array_real_with_order->proc~sort_array_real_with_order proc~c_f_string c_f_string proc~surf2scal->proc~c_f_string proc~unit2iuf unit2IUf proc~surf2scal->proc~unit2iuf proc~trans_surf_txt->proc~get_unit~2 proc~trans_surf_txt->proc~c_f_string proc~empty empty proc~trans_surf_txt->proc~empty proc~unit2iuc->proc~unit2iuf proc~c_f_string->proc~empty

Called by

proc~~read_surf~2~~CalledByGraph proc~read_surf~2 read_surf program~test_surfile test_surfile program~test_surfile->proc~read_surf~2

Source Code

   subroutine read_surf(nom_fic, mu, sq, tab_s, scal)
   implicit none
   character(len=*), intent(in )            :: nom_fic               !! *file name*
   real(kind=R8),    intent(in ), optional  :: mu                    !! *desired mean*
   real(kind=R8),    intent(in ), optional  :: sq                    !! *desired height standard deviation*
   type(SCALE_SURF), intent(out)            :: scal                  !! *object [[SCALE_SURF]]*
   real(kind=R8), dimension(:,:), allocatable, intent(out) :: tab_s  !! *height array*

      integer(kind=I4) :: style, i, ii, j, jj, k, nb, eof, tmp, nx, ny
      real(kind=R8)    :: sqs, mean, dz, lx, ly, lz
      type(OBJ_SURF)   :: surf
      character(len=3) :: ext
      real(kind=R8),    dimension(:), allocatable :: x, y, z

      i   = len_trim(nom_fic)
      ext = lower( nom_fic(i-2:i) )

      if (ext == 'dat') style = SURF_DAT
      if (ext == 'sur') style = SURF_SUR

      select case (style)
         case (SURF_SUR)
            call open_surffile(fichier=trim(nom_fic), surf=surf, scal=scal, dump=.false.)
            call trans_surf_tab(surf=surf, tab=tab_s)

         case (SURF_DAT)
            call get_unit(k)
            open(unit=k, file=trim(nom_fic), status='old')
               nb = 0
               do
                  read(k, *, iostat=eof)
                  if ( eof/=0 ) exit
                  nb = nb +1
               enddo
            rewind(k)
               allocate( x(1:nb) )
               allocate( y(1:nb) )
               allocate( z(1:nb) )
               do i = 1, nb
                  read(k, *) x(i), y(i), z(i)
               enddo
            close(k)

            ! the triplet x, y, z is sorted according x
            !-----------------------------------------------------------
            call sort_array2(tab_inout = x(1:nb),           &  !
                                  tab1 = y(1:nb),           &  !
                                  tab2 = z(1:nb), n = nb)      !
            i = 1
            do
               if ( abs(x(i) -x(1)) > 100*EPS_R8 ) exit
               i = i +1
            enddo
            scal%dx = abs(x(i) -x(1))

            j = 1
            do
               if (abs(x(j +1) -x(j))>1.0e-10) exit
               j = j +1
            enddo

            ny = j ! number of same abscissae for a given column
            if (mod(nb, ny) /=0 ) STOP 'READ_SURF, non rectangular mesh'

            nx = nb/ny

            scal%xres = nx
            scal%yres = ny

            do i = 1, nx
               ii = (i-1)*ny +1
               jj = ii +ny -1

               call sort_array2(tab_inout = y(ii:jj),                    &  !
                                     tab1 = z(ii:jj), n = jj - ii + 1)      !
            enddo

            j = 1
            do
               if ( abs(y(j) -y(1)) > 100*EPS_R8 ) exit
               j = j +1
            enddo
            scal%dy = abs(y(j) -y(1))

            allocate( tab_s(1:nx, 1:ny) )
            k = 0
            do i = 1, nx
               do j = 1, ny
                  k = k +1
                  tab_s(i, j) = z(k)
               enddo
            enddo

            lx = maxval(x)     -minval(x)
            ly = maxval(y)     -minval(y)
            lz = maxval(tab_s) -minval(tab_s)

            scal%dz = lz/(nx*ny)

            scal%xlength_unit = 'm ' ; scal%dx_unit = 'm '
            scal%ylength_unit = 'm ' ; scal%dy_unit = 'm '
            scal%zlength_unit = 'm ' ; scal%dz_unit = 'm '
            !call sort_real(g=1, d=nx*ny, rtabref=z(1:nx*ny))
            !scal%dz = 1.e+10
            !do i = 2, nx*ny
            !   dz = z(i) -z(i-1)
            !   if (abs(dz) < 100*EPS_R8) cycle
            !   scal%dz = min(scal%dz, dz)
            !enddo
            !scal%dz = dz

            deallocate(x, y, z)

      endselect

      nx = scal%xres
      ny = scal%yres

      scal%mu =  sum(  tab_s(1:nx, 1:ny)               ) / (nx * ny)
      scal%si = (sum( (tab_s(1:nx, 1:ny) -scal%mu) ** 2) / (nx * ny)) ** (0.5_R8)

      ! centering ?
      if ( present(mu) ) then
         tab_s(1:nx, 1:ny) = (tab_s(1:nx, 1:ny) -scal%mu) + mu
      endif

      ! scaling ?
      if ( present(sq) ) then
         mean =  sum(  tab_s(1:nx, 1:ny)            ) / (nx * ny)
         sqs  = (sum( (tab_s(1:nx, 1:ny) -mean) ** 2) / (nx * ny)) ** (0.5_R8)

         tab_s(1:nx, 1:ny) = sq*(tab_s(1:nx, 1:ny) -mean)/sqs + mean
      endif

   return
   endsubroutine read_surf