win_prepini.f

SUBROUTINE win_prepini

!*
!*  Implementation and Revisions:
!*  -----------------------------
!*
! 15.08.11 Su Zwischendruck bei treeini raus
! 24.02.11 Su stand_id als Character
! 01.02.05 ag win_prepini: help_ip set to actual run number
! 28.01.05 Su  


! check stand_id from multi-stand-intialisaton file (...tree.ini)
! lmulti = 0  ==> single initialisation file

  USE data_simul
  USE data_site
  USE data_stand
  USE data_species
  use flag_field

  IMPLICIT NONE

  CHARACTER      :: a
  CHARACTER(30)  :: filename, text
  CHARACTER(50)  :: test_stand_id
  INTEGER        :: ios,treeunit
  LOGICAL        :: exs, lstin
  INTEGER        :: help_ip, test_vf, i
  REAL           :: test_patchsize, xx

  IF(site_nr==1) THEN
      help_ip=site_nr
  ELSE
      help_ip=act_run
  END IF

! when initialization stand flag == 1
IF(flag_stand>0) then
    exs = .false.
    stand_id = standid(help_ip)
    ! reading stand information from treefile
    inquire (File = treefile(help_ip), exist = exs)
    IF(exs .eqv. .false.) write(*,*) '  Stand initialization file not exists!'

    ! read values from treefile
    IF (exs.eqv. .true.)  then
       treeunit=getunit()
       OPEN(treeunit,file=treefile(help_ip),action='read', pad='YES')
       READ(treeunit,'(I1,F12.0)',iostat=ios) test_vf, test_patchsize

       IF(test_patchsize .GT. 0.) THEN
         lmulti = .FALSE.
         IF(test_patchsize.NE.kpatchsize) THEN
           CALL error_mess(time,"patch size in sim-file and the one used for initialisation do not match",kpatchsize)
           CALL error_mess(time,"value in ini-file",test_patchsize)
           CALL error_mess(time,"value in sim-file",kpatchsize)
             kpatchsize = test_patchsize
         ENDIF
       ELSE
           lmulti = .TRUE.
      ! count number of stand_id
           anz_standid = 0
           do
             READ(treeunit,'(A)',iostat=ios) a
             IF (a .ne. '!') exit
           end do
           
           do  
               read(treeunit,*,iostat=ios) xx
               IF (ios .lt. 0) exit
               anz_standid = anz_standid + 1
                  do while (xx .gt. -90.0)
                     read (treeunit,*) xx
!                     print *,xx
                  enddo  ! xx
           enddo
           if (allocated(standid_list)) deallocate(standid_list)
           allocate (standid_list(anz_standid))
           rewind treeunit

      ! read stand_id
           read (treeunit,*) xx
           do
             READ(treeunit,'(A)',iostat=ios) a
             IF (a .ne. '!') exit
           end do
           backspace treeunit

           lstandid = .FALSE.
           do  i = 1, anz_standid 
               read(treeunit,*) test_stand_id, test_patchsize, text
               standid_list(i) = test_stand_id
               if (test_stand_id .eq. stand_id) lstandid = .TRUE.

               read (treeunit,*) xx
                  do while (xx .gt. -90.0)
                     read (treeunit,*) xx
                  enddo  ! xx
           enddo

       END IF   ! test_patchsize  --  lmulti
       CLOSE(treeunit)
    END IF   ! exs
END IF

END SUBROUTINE win_prepini