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