trans_surf_txt Subroutine

public subroutine trans_surf_txt(surf, fichier, xyz)

Note

Writes an OBJ_SURF object in a text file

The object components are first written in a fortran string, then it is written into the file with a comment

Arguments

Type IntentOptional Attributes Name
type(OBJ_SURF), intent(in) :: surf

object OBJ_SURF
character(len=*), intent(in) :: fichier

text file to write
logical(kind=I4), intent(in) :: xyz

whether to also write the heights (maybe huge)

Calls

proc~~trans_surf_txt~~CallsGraph proc~trans_surf_txt trans_surf_txt proc~c_f_string c_f_string proc~trans_surf_txt->proc~c_f_string proc~empty empty proc~trans_surf_txt->proc~empty proc~get_unit~2 get_unit proc~trans_surf_txt->proc~get_unit~2 proc~c_f_string->proc~empty

Called by

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

Source Code

   subroutine trans_surf_txt(surf, fichier, xyz)
   implicit none
   type(OBJ_SURF), intent(in)   :: surf      !! *object [[OBJ_SURF]]*
   character(len=*), intent(in) :: fichier   !! *text file to write*
   logical(kind=I4), intent(in) :: xyz       !! *whether to also write the heights (maybe huge)*

      integer(kind=I4) :: i, k, s
      character(len=512) :: string, cc

      call get_unit(k)

      open(k, file=trim(fichier))

         call c_f_string(cs=surf%signature, fs=string, lngth_s=s)
         write(cc,*) '"',trim(string(1:s)),'"'  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "signature              " ; call empty(cc)
         write(cc,*) surf%format                ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "format                 " ; call empty(cc)
         write(cc,*) surf%nobjects              ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "nobjects               " ; call empty(cc)
         write(cc,*) surf%version               ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "version                " ; call empty(cc)
         write(cc,*) surf%type                  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "type                   " ; call empty(cc)
         call c_f_string(cs=surf%object_name, fs=string, lngth_s=s)
         write(cc,*) '"',trim(string(1:s)),'"'  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "object_name            " ; call empty(cc)
         call c_f_string(cs=surf%operator_name, fs=string, lngth_s=s)
         write(cc,*) '"',trim(string(1:s)),'"'  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "operator_name          " ; call empty(cc)
         write(cc,*) surf%material_code         ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "material_code          " ; call empty(cc)
         write(cc,*) surf%acquisition           ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "acquisition            " ; call empty(cc)
         write(cc,*) surf%range                 ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "range                  " ; call empty(cc)
         write(cc,*) surf%special_points        ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "special_points         " ; call empty(cc)
         write(cc,*) surf%absolute              ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "absolute               " ; call empty(cc)
         call c_f_string(cs=surf%reserved, fs=string, lngth_s=s)
         write(cc,*) '"',trim(string(1:s)),'"'  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "reserved               " ; call empty(cc)
         write(cc,*) surf%pointsize             ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "pointsize              " ; call empty(cc)
         write(cc,*) surf%zmin                  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "zmin                   " ; call empty(cc)
         write(cc,*) surf%zmax                  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "zmax                   " ; call empty(cc)
         write(cc,*) surf%xres                  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "xres                   " ; call empty(cc)
         write(cc,*) surf%yres                  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "yres                   " ; call empty(cc)
         write(cc,*) surf%nofpoints             ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "nofpoints              " ; call empty(cc)
         write(cc,*) surf%dx                    ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "dx                     " ; call empty(cc)
         write(cc,*) surf%dy                    ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "dy                     " ; call empty(cc)
         write(cc,*) surf%dz                    ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "dz                     " ; call empty(cc)
         call c_f_string(cs=surf%xaxis, fs=string, lngth_s=s)
         write(cc,*) '"',trim(string(1:s)),'"'  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "xaxis                  " ; call empty(cc)
         call c_f_string(cs=surf%yaxis, fs=string, lngth_s=s)
         write(cc,*) '"',trim(string(1:s)),'"'  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "yaxis                  " ; call empty(cc)
         call c_f_string(cs=surf%zaxis, fs=string, lngth_s=s)
         write(cc,*) '"',trim(string(1:s)),'"'  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "zaxis                  " ; call empty(cc)
         call c_f_string(cs=surf%dx_unit, fs=string, lngth_s=s)
         write(cc,*) '"',trim(string(1:s)),'"'  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "dx_unit                " ; call empty(cc)
         call c_f_string(cs=surf%dy_unit, fs=string, lngth_s=s)
         write(cc,*) '"',trim(string(1:s)),'"'  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "dy_unit                " ; call empty(cc)
         call c_f_string(cs=surf%dz_unit, fs=string, lngth_s=s)
         write(cc,*) '"',trim(string(1:s)),'"'  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "dz_unit                " ; call empty(cc)
         call c_f_string(cs=surf%xlength_unit, fs=string, lngth_s=s)
         write(cc,*) '"',trim(string(1:s)),'"'  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "xlength_unit           " ; call empty(cc)
         call c_f_string(cs=surf%ylength_unit, fs=string, lngth_s=s)
         write(cc,*) '"',trim(string(1:s)),'"'  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "ylength_unit           " ; call empty(cc)
         call c_f_string(cs=surf%zlength_unit, fs=string, lngth_s=s)
         write(cc,*) '"',trim(string(1:s)),'"'  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "zlength_unit           " ; call empty(cc)
         write(cc,*) surf%xunit_ratio           ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "xunit_ratio            " ; call empty(cc)
         write(cc,*) surf%yunit_ratio           ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "yunit_ratio            " ; call empty(cc)
         write(cc,*) surf%zunit_ratio           ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "zunit_ratio            " ; call empty(cc)
         write(cc,*) surf%imprint               ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "imprint                " ; call empty(cc)
         write(cc,*) surf%inversion             ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "inversion              " ; call empty(cc)
         write(cc,*) surf%leveling              ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "leveling               " ; call empty(cc)
         call c_f_string(cs=surf%obsolete, fs=string, lngth_s=s)
         write(cc,*) '"',trim(string(1:s)),'"'  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "obsolete               " ; call empty(cc)
         write(cc,*) surf%seconds               ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "seconds                " ; call empty(cc)
         write(cc,*) surf%minutes               ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "minutes                " ; call empty(cc)
         write(cc,*) surf%hours                 ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "hours                  " ; call empty(cc)
         write(cc,*) surf%day                   ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "day                    " ; call empty(cc)
         write(cc,*) surf%month                 ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "month                  " ; call empty(cc)
         write(cc,*) surf%year                  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "year                   " ; call empty(cc)
         write(cc,*) surf%dayof                 ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "dayof                  " ; call empty(cc)
         write(cc,*) surf%measurement_duration  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "measurement_duration   " ; call empty(cc)
         call c_f_string(cs=surf%obsolete2, fs=string, lngth_s=s)
         write(cc,*) '"',trim(string(1:s)),'"'  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "obsolete2              " ; call empty(cc)
         write(cc,*) surf%comment_size          ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "comment_size           " ; call empty(cc)
         write(cc,*) surf%private_size          ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "private_size           " ; call empty(cc)
         call c_f_string(cs=surf%client_zone, fs=string, lngth_s=s)
         write(cc,*) '"',trim(string(1:s)),'"'  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "client_zone            " ; call empty(cc)
         write(cc,*) surf%XOffset               ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "XOffset                " ; call empty(cc)
         write(cc,*) surf%YOffset               ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "YOffset                " ; call empty(cc)
         write(cc,*) surf%ZOffset               ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "ZOffset                " ; call empty(cc)
         call c_f_string(cs=surf%reservedzone, fs=string, lngth_s=s)
         write(cc,*) '"',trim(string(1:s)),'"'  ; write(k,'(1x,a,T130,a)') adjustl(trim(cc)), "reservedzone           " ; call empty(cc)

         if (xyz) then
            do i = 0, surf%nofpoints -1
               write(k,*) mod(i, surf%xres)*surf%dx, (i/surf%xres)*surf%dy, surf%val(i+1)*surf%dz
            enddo
         endif

      close(k)

   return
   endsubroutine trans_surf_txt