diff --git a/source_code/version2.2_windows/win_prepini.f b/source_code/version2.2_windows/win_prepini.f new file mode 100644 index 0000000000000000000000000000000000000000..9df31593665bbba600b32a43a4d1248f693e53d3 --- /dev/null +++ b/source_code/version2.2_windows/win_prepini.f @@ -0,0 +1,107 @@ +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