write_surf Subroutine

public subroutine write_surf(nom_fic, tab_s, scal)


Arguments

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

file name

real(kind=R8), intent(in), dimension(1:scal%xres, 1:scal%yres):: tab_s
type(SCALE_SURF), intent(inout) :: scal

object SCALE_SURF


Calls

proc~~write_surf~~CallsGraph proc~write_surf write_surf proc~lower lower proc~write_surf->proc~lower proc~scal2surf scal2surf proc~write_surf->proc~scal2surf proc~surf2scal surf2scal proc~write_surf->proc~surf2scal proc~get_unit get_unit proc~write_surf->proc~get_unit proc~c_f_string c_f_string proc~surf2scal->proc~c_f_string proc~empty empty proc~c_f_string->proc~empty

Called by

proc~~write_surf~~CalledByGraph proc~write_surf write_surf proc~save_ms_field save_ms_field proc~save_ms_field->proc~write_surf proc~save_fe_field save_fe_field proc~save_fe_field->proc~write_surf proc~solve_ms_prob solve_ms_prob proc~solve_ms_prob->proc~save_ms_field proc~solve_fe_prob solve_fe_prob proc~solve_fe_prob->proc~save_fe_field proc~test_rough_fe test_rough_fe proc~test_rough_fe->proc~solve_fe_prob proc~test_bearing_x_fe test_bearing_x_fe proc~test_bearing_x_fe->proc~solve_fe_prob proc~test_pocket_fe test_pocket_fe proc~test_pocket_fe->proc~solve_fe_prob proc~test_bearing_y_fe test_bearing_y_fe proc~test_bearing_y_fe->proc~solve_fe_prob proc~test_rough_ms test_rough_ms proc~test_rough_ms->proc~solve_ms_prob proc~test_slider_fe test_slider_fe proc~test_slider_fe->proc~solve_fe_prob proc~test_slider_ms test_slider_ms proc~test_slider_ms->proc~solve_ms_prob proc~run_test run_test proc~run_test->proc~test_rough_fe proc~run_test->proc~test_bearing_x_fe proc~run_test->proc~test_pocket_fe proc~run_test->proc~test_bearing_y_fe proc~run_test->proc~test_rough_ms proc~run_test->proc~test_slider_fe proc~run_test->proc~test_slider_ms program~main main program~main->proc~run_test

Contents

Source Code


Source Code

   subroutine write_surf(nom_fic, tab_s, scal)
   implicit none
   character(len=*), intent(in)    :: nom_fic   !! *file name*
   type(SCALE_SURF), intent(inout) :: scal      !! *object [[SCALE_SURF]]*
   real(kind=R8), dimension(1:scal%xres, 1:scal%yres), intent(in) :: tab_s
      character(len=3) :: ext
      integer(kind=I4) :: style, i, j, k
      type(OBJ_SURF)   :: surf_s
      real(kind=R8)    :: dx, dy

      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 scal2surf(scal, surf_s)
            call build_surf(surf=surf_s, tab=tab_s(1:scal%xres, 1:scal%yres))
            surf_s%comment_size = 0 ! to increase compatibility with mountains
            call write_surffile(fichier=trim(nom_fic), surf=surf_s)
            call surf2scal(surf_s, scal)

         case (SURF_DAT)
            dx = scal%dx
            dy = scal%dy
            call get_unit(k)
            open(k, file=trim(nom_fic))
               do i = 1, scal%xres
                  do j = 1, scal%yres
                     write(k,*) (i-1)*dx, (j-1)*dy, tab_s(i, j)
                  enddo
               enddo
            close(k)
      endselect
   return

   endsubroutine write_surf