From e009a8f57a8c6dfeba415415327ca3647c9da5a2 Mon Sep 17 00:00:00 2001
From: Petra Lasch-Born <lasch@pik-potsdam.de>
Date: Wed, 12 Dec 2018 17:01:50 +0100
Subject: [PATCH] Eine Neue Datei hochladen

---
 source_code/version2.2_windows/win_prepini.f | 107 +++++++++++++++++++
 1 file changed, 107 insertions(+)
 create mode 100644 source_code/version2.2_windows/win_prepini.f

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 0000000..9df3159
--- /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
-- 
GitLab