Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
!*****************************************************************!
!* *!
!* 4C (FORESEE) *!
!* *!
!* *!
!* Subroutines for: *!
!* management *!
!* contains: *!
!* SR manag_ini *!
!* SR manag_menu *!
!* SR simple_ini *!
!* SR adap_ini *!
!* SR management *!
!* SR simple_manag *!
!* SR adap_manag *!
!* SR target_manag *!
!* SR target_ini *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under: *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/foresee/4C *!
!* *!
!*****************************************************************!
SUBROUTINE manag_ini
use data_manag
use data_simul
use data_stand
implicit none
!call manag_menu
select case(flag_mg)
case(1)
call simple_ini
case(2)
if(anz_spec.ne.0) call adap_ini
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
call target_ini
case(44)
call man_liocourt_ini
case(8)
call aspman_ini
case(9)
call aust_ini
end select
contains
SUBROUTINE simple_ini
! read definition of simple thinning from file
integer :: manag_unit,i
character(len=150) :: filename
logical :: ex
manag_unit=getunit()
filename = manfile(ip)
call testfile(filename,ex)
open(manag_unit,file=trim(filename))
read(manag_unit,*) thin_nr ! number of thinning years
allocate(thin_year(thin_nr));allocate(thin_tree(thin_nr))
do i=1,thin_nr
read(manag_unit,*) thin_year(i),thin_tree(i)
end do
close(manag_unit)
end SUBROUTINE simple_ini
end SUBROUTINE manag_ini
!-------------------------------------------------
! control of management regime and call
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE management
use data_simul
use data_stand
use data_species
use data_manag
use data_out
implicit none
integer diffanz
if (flag_standup .eq. 0) flag_standup = 1
select case(flag_mg)
case(1)
call simple_manag
case(2)
call adap_manag
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
call target_manag
case(44)
call liocourt_manag
case(8)
call asp_manag
case(9)
call aust_manag
case(10)
call dis_manag
case default
end select
contains
SUBROUTINE simple_manag
integer taxnr, cohnr
real minheight
! simple thinning with fitting to default stem number
if(anz_tree>thin_tree(act_thin_year)) then
diffanz = anz_tree - thin_tree(act_thin_year)
minheight = 100000.
do
!repeat while diffanz>0)
if(diffanz<0.1) exit
zeig=>pt%first
!search for cohort with minimal height
do
if(.not.associated(zeig)) exit
if(zeig%coh%ntreea>0.1 .and. zeig%coh%height<minheight)then
minheight=zeig%coh%height; cohnr=zeig%coh%ident
endif
zeig=>zeig%next
enddo
! delete smallest trees
zeig=>pt%first
do
if(.not.associated(zeig)) exit
if(zeig%coh%ident==cohnr)then
if(diffanz <= zeig%coh%ntreea) then
zeig%coh%ntreea = zeig%coh%ntreea - diffanz
zeig%coh%ntreem = diffanz
diffanz=0.
else
diffanz = diffanz - zeig%coh%ntreea
zeig%coh%ntreem = zeig%coh%ntreea
zeig%coh%ntreea = 0.
endif
minheight=100000.
exit
endif
zeig=>zeig%next
enddo
enddo
else
call error_mess(time,"no management possible, tree number undersized : ", REAL(anz_tree))
endif
! number of trees and litter pools of managed trees
zeig=>pt%first
anz_tree=0.
do
if(.not.associated(zeig)) exit
taxnr=zeig%coh%species
anz_tree=anz_tree+zeig%coh%ntreea
if(zeig%coh%ntreem>0 .and.zeig%coh%ntreed==0.)then
zeig%coh%litC_fol = zeig%coh%litC_fol + (1.-spar(taxnr)%psf)*zeig%coh%x_fol/2.
zeig%coh%litN_fol = zeig%coh%litN_fol + ((1.-spar(taxnr)%psf)*zeig%coh%x_fol/2.)*0.02
zeig%coh%litC_frt = zeig%coh%litC_frt + zeig%coh%x_frt/2.
zeig%coh%litN_frt = zeig%coh%litN_frt + (zeig%coh%x_frt/2.)*0.023
endif
zeig=>zeig%next
enddo
end SUBROUTINE simple_manag
end SUBROUTINE management
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! input of control parameters for adaptation management
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE adap_ini
use data_manag
use data_simul
use data_species
use data_stand
use data_out
implicit none
! read definition of adapted thinning from file
integer :: manag_unit,i,j
character(len=150) :: filename
logical :: ex
character ::text
manag_unit=getunit()
filename = manfile(ip)
allocate(zbnr(nspec_tree))
allocate(tend(nspec_tree))
allocate(rot(nspec_tree))
allocate(thin_flag1(nspec_tree))
allocate(thin_flag2(nspec_tree))
allocate(thin_flag3(nspec_tree))
allocate(thin_flag4(nspec_tree))
allocate(regage(nspec_tree))
allocate(np_mod(nspec_tree))
allocate(thinyear(nspec_tree))
allocate(specnr(nspec_tree))
allocate(age_spec(nspec_tree))
allocate(anz_tree_spec(nspec_tree))
thinyear =0
thin_flag1=0
thin_flag2=0
thin_flag3=0
thin_flag4=0
flag_manreal = 0
flag_shelter = 0
shelteryear = 0
call testfile(filename,ex)
open(manag_unit,file=trim(filename))
! read head of data-file
do
read(manag_unit,*) text
if(text .ne. '!')then
backspace(manag_unit);exit
endif
enddo
! dominant species
read(manag_unit,*) domspec
! domimant height levels
read(manag_unit,*) ho1,ho2,ho3,ho4
! thinning regimes
read (manag_unit,*) thin_flag1(1),thr1, thr2,thr3,thr4,thr5,thr6, thr7, mgreg, domspec_reg
do j=2,nspec_tree
thin_flag1(j)= thin_flag1(1)
end do
if(thin_flag1(1) <0) then
close(manag_unit)
return
end if
! limit for hight query
read (manag_unit,*) limit
!test
limit = limit + 30.
! number of years between thinning
read (manag_unit,*) thinstep
! relative thinning for young trees
read (manag_unit,*) direcfel
! control variables for thinning depending on basal area
read (manag_unit,*) thin_ob, optb
! number of 'Zielb�ume' (target trees)
read (manag_unit,*) (zbnr(i), i =1, nspec_tree)
! relative thinning value for tending of plantations
read (manag_unit,*) (tend(i), i =1, nspec_tree)
! rotation
read (manag_unit,*) (rot(i), i =1, nspec_tree)
! age of natural/planted regeneration
read (manag_unit,*) (regage(i), i =1, nspec_tree)
do j= 1,20
read (manag_unit,*) (usp(j,i), i=1,13)
end do
read (manag_unit,*) (np_mod(i), i = 1,nspec_tree)
close(manag_unit)
if (flag_reg .ne. 0) then
WRITE(unit_ctr,*) ' '
WRITE(unit_ctr,*) '***Managment parameter case flag_mg = 2 (user specified) ***'
WRITE(unit_ctr,'(A35,4F15.5)') 'height for management control(cm)', ho1,ho2,ho3,ho4
WRITE(unit_ctr,'(A35,6I15)') 'man. flags thin_flag1, thr1-thr5' , thin_flag1(1),thr1,thr2, thr3,thr4,thr5
WRITE(unit_ctr,'(A35,F15.5)') 'height for directional felling', thr6
WRITE(unit_ctr,'(A35,I15)') 'measure at rotation', thr7
WRITE(unit_ctr,'(A35,I15)') 'regeneration measure', mgreg
WRITE(unit_ctr,'(A35,F15.5)') 'lower/upper limit of height(cm)', limit
WRITE(unit_ctr,'(A35,I15)') 'number of years between thinning',thinstep
WRITE(unit_ctr,'(A35,F15.5)') 'rel. value for directional felling', direcfel
WRITE(unit_ctr,'(A35,2F15.5)') 'thinning depending on basal area function thin_ob (0,1), optb ', thin_ob, optb
WRITE(unit_ctr,'(A35,5F15.5)')'number of Zielb�ume (spec.)', (zbnr(i),i=1,nspec_tree)
WRITE(unit_ctr,'(A35,5F15.5)')'rel. value for tending of pl.',(tend(i), i =1,nspec_tree)
WRITE(unit_ctr,'(A35,5I15)')'rotation ',(rot(i), i =1,nspec_tree)
WRITE(unit_ctr,'(A35,5I15)')'age of nat./pl. regeneration',(regage(i), i =1,nspec_tree)
close(unit_ctr)
end if
end SUBROUTINE adap_ini
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! routines for adaptation management
! based on concepts from P. Mohr, P.Lasch. D. Gerold....
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE adap_manag
use data_stand
use data_manag
use data_simul
use data_par
use data_species
implicit none
real :: c1, &
helphd,helpmax, helpi, & ! hdom species specific
domage
real :: sumdh, sumd ! for calculation of HG
real :: bg ! stocking degree
real :: stage
real :: dfbg ! optimal basal area
real :: hg ! height of DG
integer :: c2, &
taxnr, &
actspec, & ! number of species for thinning
th_help, i,j ,k, &
testflag, &
nrfel, &
flag_prep, &
flag_fell, &
inum, &
domage_sh, &
domspec_sh, &
flag_reg_act
real,dimension(nspecies) :: bas_area_spec
real,dimension(nspecies) :: help
flag_reg_act = 100
domage = 0.
domspec_sh = 0
help = 0.
helpmax = 0.
helpi =0
bas_area_spec = 0.
domage_sh = 0
flag_fell = 0
stand_age=0
flag_prep = 0
anz_tree_spec = 0
anz_tree_dbh = 0
flag_adapm = 0.
specnr = 0.
age_spec = 0.
basarea_tot = 0.
sumd = 0.
sumdh = 0.
! determine number of species in cohort list
if(anz_spec.eq.0) return
if(thin_flag1(1) <0) return
IF(anz_spec.eq.1) then
! stand age as maximum age of cohorts
zeig => pt%first
DO
IF (.NOT. ASSOCIATED(zeig)) EXIT
if(zeig%coh%species.le.nspec_tree) then
taxnr = zeig%coh%species
if(zeig%coh%x_age.gt. stand_age) stand_age = zeig%coh%x_age
if(zeig%coh%ntreea.ne.0.and. zeig%coh%diam.gt.0.) then
sumd = sumd + zeig%coh%diam*zeig%coh%diam
sumdh = sumdh + zeig%coh%diam*zeig%coh%diam*zeig%coh%height
basarea_tot = basarea_tot + zeig%coh%ntreea*(zeig%coh%diam**2)*pi/4.
bas_area_spec(taxnr) = bas_area_spec(taxnr) + zeig%coh%ntreea*(zeig%coh%diam**2)*pi/4.
end if
end if
zeig=>zeig%next
END DO
ELSE if(anz_spec.gt.1) then
! age of species i as maximum age of cohorts of this species
testflag = 0
i=1
zeig => pt%first
DO
IF (.NOT. ASSOCIATED(zeig)) EXIT
taxnr = zeig%coh%species
if(zeig%coh%ntreea.ne.0.and. zeig%coh%diam.gt.0.) then
basarea_tot = basarea_tot + zeig%coh%ntreea*(zeig%coh%diam**2)*pi/4.
bas_area_spec(taxnr) = bas_area_spec(taxnr) + zeig%coh%ntreea*(zeig%coh%diam**2)*pi/4.
end if
if(i.eq.1) then
specnr(i) = zeig%coh%species
if(zeig%coh%x_age.gt. age_spec(i)) age_spec(i) = zeig%coh%x_age
i = i+1
else
do j= 1,i-1
if(specnr(j).eq. zeig%coh%species) testflag = 1
end do
if (testflag.eq.0) then
specnr(i) = zeig%coh%species
if(zeig%coh%x_age.gt. age_spec(i)) age_spec(i) = zeig%coh%x_age
i = i+1
end if
testflag=0
end if
zeig=>zeig%next
END DO
DO i =1,anz_spec
zeig => pt%first
DO
IF (.NOT. ASSOCIATED(zeig)) EXIT
if(zeig%coh%species.eq.specnr(i).and.zeig%coh%x_age.gt. age_spec(i)) age_spec(i)= zeig%coh%x_age
zeig=>zeig%next
END DO
END DO
! if domspec is -99 then domspec is calculated by basal area
if( domspec.lt. 0 ) then
DO i = 1,nspecies
if (basarea_tot.ne.0) then
help(i) = bas_area_spec(i)/basarea_tot
if(help(i).gt. helpmax) then
helpmax = help(i)
helpi = i
end if
end if
end do
domspec = helpi
end if
! re-sorting of the filed specnr (at the first place of this field is the number of the dominanat species);
! this is necessary for managemnt of mixed stands becuase this management is according to the management
! of the dominanat species
! age of domspec
zeig => pt%first
DO
IF (.NOT. ASSOCIATED(zeig)) EXIT
if(zeig%coh%species.eq.domspec) then
if(zeig%coh%x_age.gt.domage) domage = zeig%coh%x_age
end if
zeig=>zeig%next
END DO
if(specnr(1).ne.domspec) then
do k=2,anz_spec
if(specnr(k).eq.domspec) then
specnr(k)=specnr(1)
age_spec(k)=age_spec(1)
specnr(1) = domspec
age_spec(1)=domage
exit
end if
end do
end if ! re-sorting
! species for shelterwood which is oldest
zeig => pt%first
DO
IF (.NOT. ASSOCIATED(zeig)) EXIT
if(zeig%coh%shelter.eq.1.and.zeig%coh%x_age.gt.domage.and.zeig%coh%x_age.gt.domage_sh) domage_sh = zeig%coh%x_age
zeig=>zeig%next
END DO
zeig => pt%first
DO
IF (.NOT. ASSOCIATED(zeig)) EXIT
if(zeig%coh%x_age.eq.domage_sh) domspec_sh = zeig%coh%species
zeig=>zeig%next
END DO
END IF
if (anz_spec.eq.1) then
specnr(1) = taxnr
age_spec(1) = stand_age
if(domspec.lt.0) domspec = taxnr
end if
DO i=1,anz_spec
anz_tree_spec(i) = 0
! caclulation of species specific number of trees
zeig=>pt%first
do
if(.not.associated(zeig)) exit
zeig%coh%ntreem = 0.
if(zeig%coh%diam.gt.0) anz_tree_dbh = anz_tree_dbh + zeig%coh%ntreea
if(zeig%coh%species.eq.specnr(i)) anz_tree_spec(i) = anz_tree_spec(i) + zeig%coh%ntreea
zeig=> zeig%next
end do
END DO ! species loop
if(domspec.lt.0) then
if(domage_sh.gt.domage) then
domage = domage_sh
domspec = domspec_sh
end if
end if
DO i=1,anz_spec
actspec = specnr(i)
zeig => pt%first
DO
IF (.NOT. ASSOCIATED(zeig)) EXIT
if(zeig%coh%species.le.nspec_tree) then
taxnr = zeig%coh%species
if(zeig%coh%ntreea.ne.0.and. zeig%coh%diam.gt.0..and.zeig%coh%species.eq.taxnr) then
stage = zeig%coh%x_age
sumd = sumd + zeig%coh%diam*zeig%coh%diam
sumdh = sumdh + zeig%coh%diam*zeig%coh%diam*zeig%coh%height
end if
end if
zeig=>zeig%next
END DO
! calculation HG (height for DG)
if(sumdh.ne.0) then
hg = (sumdh/sumd)/100.
else
hg = 0.
end if
IF (specnr(i).ne.0..and. domspec.ne.0) THEN
select case(thr7)
case(1) ! thr7
! shelterwood management
if(domspec.eq.actspec) then
if (age_spec(i).ge.regage(specnr(i)).and. age_spec(i).lt.(rot(specnr(i))-15.).and. time.ne.1) then
if(shelteryear.eq.0.and.flag_shelter.eq.0) flag_reg = mgreg
inum = i
if (flag_sh_first.ne.2) then
call shelterwood_man(specnr(inum),inum,domage)
end if
if(shelteryear.eq.0) flag_sh_first = 1
flag_shelter = 1
if(flag_sh_first.ne.2) then
select case(flag_reg)
case(1) ! mgreg
! natural regeneration allowed
flag_reg = 1
case(4,5,6,7,8,9,10,11,12,13,14,15) ! mgreg
! artificial regeneration
if(flag_reg_act.ne.0) call planting
flag_reg = 0
flag_reg_act = 0
end select
end if
flag_prep = 1
else if (age_spec(i).ge.rot(specnr(i)).and. time.ne.1) then
! clear felling
nrfel = specnr(i)
call felling(nrfel,i)
flag_manreal = 1
flag_shelter = 0
maninf = 'felling after shelterwood s.'
meas = 0
! set back because shelterwood m. is finished, management of regenerated stand starts
shelteryear = 0.
thin_flag1 = 0
thin_flag2 = 0
thin_flag3 = 0
thin_flag4 = 0
flag_prep = 1
if(flag_plant_shw.eq.1) then
! if no first and second sherterwood management was possibele than after clear cut planting is called
select case(mgreg)
case(1) ! mgreg
! natural regeneration allowed
flag_reg = 1
case(4,5,6,7,8,9,10,11,12,13,14,15) ! mgreg
! artificial regeneration
if(flag_reg_act.ne.0) then
flag_reg = mgreg
call planting
end if
flag_reg = 0
flag_reg_act = 0
flag_plant_shw =0
end select
end if
! if initial age is grater than age for first shleterwood treatment
else if(time.eq.1.and. age_spec(i).gt.regage(specnr(i)).and. age_spec(i).gt.(rot(specnr(i))-20) ) then
! flags for planting if felling is realised
flag_plant_shw = 1
flag_reg_act = 1
! in this case: to avoid sheletrwood management until rotation time
flag_sh_first = 2
shelteryear = 99
! labelling of cohorts as sheletrwood cohorts
zeig=>pt%first
do
if(.not.associated(zeig)) exit
zeig%coh%shelter=1
zeig=> zeig%next
end do
exit
else if(time.eq.1.and. age_spec(i).gt.regage(specnr(i)).and. age_spec(i).le.(rot(specnr(i))-20.)) then
! if initial age is greater than regeneration age(first shelterwood treatm.) and not too near to rotation age
! a new rotation age is defined with delaying
rot(specnr(i)) = rot(specnr(i)) + (age_spec(i) - regage(specnr(i)))
if(shelteryear.eq.0.and.flag_shelter.eq.0) flag_reg = mgreg
inum = i
call shelterwood_man(specnr(inum),inum,domage)
if(shelteryear.eq.0) flag_sh_first = 1
flag_shelter = 1
select case(flag_reg)
case(1) ! mgreg
! natural regeneration allowed
flag_reg = 1
case(4,5,6,7,8,9,10,11,12,13,14,15) ! mgreg
! artificial regeneration
if(flag_reg_act.ne.0) call planting
flag_reg = 0
flag_reg_act = 0
end select
end if
else if(domspec.ne.actspec) then
if (domage.ge.regage(domspec).and.domage.lt.(rot(domspec)-15.)) then
if(shelteryear.eq.0) flag_reg = mgreg
inum=i
call shelterwood_man(specnr(inum),inum, domage)
flag_shelter = 1
if(shelteryear.eq.0) flag_sh_first = 1
select case(flag_reg)
case(1) ! mgreg
! natural regeneration allowed
flag_reg = 1
case(4,5,6,7,8,9,10,11,12,13,14,15) ! mgreg
! artificial regeneration
if(flag_reg_act.ne.0) call planting
flag_reg = 0
flag_reg_act = 0
end select
flag_prep = 1
else if(thr7.eq.1 .and. domage.eq.rot(domspec)) then
else if(actspec.eq.rot(actspec)) then
! clear felling
nrfel = specnr(i)
call felling(nrfel,i)
flag_manreal = 1
flag_shelter = 0
maninf = 'felling after shelterwood s.'
meas = 0
! set back because shelterwood m. is finished, management of regenerated stand starts
shelteryear = 0.
thin_flag1 = 0
thin_flag2 = 0
thin_flag3 = 0
thin_flag4 = 0
flag_prep = 1
end if
end if
case(2) ! thr7
! clear felling
if(age_spec(i).ge.(rot(specnr(i))-15).and.age_spec(i).lt.rot(specnr(i)) ) then
zeig=>pt%first
do
if(.not.associated(zeig)) exit
if(zeig%coh%species.eq.specnr(i).and. zeig%coh%x_age.eq. age_spec(i)) zeig%coh%shelter = 1
zeig=>zeig%next
end do
flag_prep = 1
else if (age_spec(i).eq.rot(specnr(i))) then
nrfel = specnr(i)
call felling (nrfel,i)
flag_manreal = 1
flag_fell = 1
thinyear(actspec) = time
thin_flag1 = 0
thin_flag2 = 0
thin_flag3 = 0
thin_flag4 = 0
maninf = 'felling'
meas =0
call input_manrec
else if(age_spec(i).gt. rot(specnr(i)).and. time.eq.1) then
nrfel = specnr(i)
call felling (nrfel,i)
flag_manreal = 1
flag_fell = 1
thinyear(actspec) = time
thin_flag1 = 0
thin_flag2 = 0
thin_flag3 = 0
thin_flag4 = 0
maninf = 'felling'
meas =0
call input_manrec
end if
case default
end select
! tending of plantations (Jungwuchspflege)
! test if rotation age is not during the next 15 years
IF (flag_prep .eq. 0. .and. flag_shelter .eq.0) then
helphd= svar(specnr(i))%dom_height
if ( thinonce.eq.1) then
c1 = ho3
c2 = thr4
CALL thinning (c1,c2,actspec,i)
flag_manreal=1
maninf = 'thinning'
meas = thr1
thinyear(actspec)=time
call input_manrec
end if
if( thinonce.eq.0) then
IF ( (helphd.ge.(ho1-60.).and. helphd.le.(ho1+60.)).and. thin_flag1(actspec).eq.0) THEN
CALL tending(actspec,i)
flag_manreal = 1
maninf = 'tending'
meas = 0
call input_manrec
thin_flag1(actspec)=1
flag_adapm = 1
! management at different dominant heights
ELSE IF( helphd.ge.(ho1-60).and.helphd.le.(ho4+limit)) then
IF((helphd.ge.(ho2-limit).and. helphd.le.(ho2+limit)).and. (thin_flag2(actspec).eq.0).or.( thin_flag2(actspec).eq.0.and. thin_flag2(domspec).eq.1))THEN
if(actspec.eq.domspec .or. thin_flag2(domspec).eq.1) then
c1= ho2
c2= thr1
thin_flag2(actspec)=1
maninf = 'brushing'
! if beech, spruce, oak then tending else thinning based on basal area
if(actspec.ne.3)then
! Mod. for Cornelia
CALL tending(actspec,i)
else
CALL thinning (c1,c2,actspec,i)
end if
flag_manreal=1
meas = thr1
thinyear(actspec)=time
call input_manrec
end if
ELSE IF((helphd.ge.(ho3-limit).and. helphd.le.(ho3+limit)).and. (thin_flag3(actspec).eq.0).or.( thin_flag3(actspec).eq.0.and. thin_flag3(domspec).eq.1)) THEN
if(actspec.eq.domspec .or. thin_flag3(domspec).eq.1) then
c1= ho3
c2= thr2
thin_flag3(actspec)= 1
CALL thinning (c1,c2,actspec,i)
flag_manreal = 1
maninf = 'thinning'
meas = thr2
thinyear(actspec)=time
call input_manrec
end if
ELSE IF( (helphd.ge.(ho4-limit).and. helphd.le.(ho4+limit)).and. (thin_flag4(actspec).eq.0).or.( thin_flag4(actspec).eq.0.and. thin_flag4(domspec).eq.1)) THEN
if(actspec.eq.domspec .or. thin_flag3(domspec).eq.1) then
c1= ho4
c2= thr3
thin_flag4(actspec)= 1
CALL thinning (c1,c2,actspec,i)
flag_manreal = 1
maninf = 'thinning'
meas = thr3
call input_manrec
thinyear(actspec) = time
end if
ENDIF
! directinal felling if not done yet
flag_adapm = 1
ELSE IF(helphd.gt. (ho4+limit)) THEN
! calculation of stocking degree
call calc_gfbg(dfbg, actspec, stage, hg)
dfbg = dfbg*kpatchsize
bg = bas_area_spec(actspec)*bas_area_spec(actspec)/(basarea_tot*dfbg)
th_help = time-thinyear(actspec)
IF(th_help.ge.thinstep.or.(bg.gt.(optb).and.time.lt.thinstep.and.thinyear(actspec).eq.0)) THEN
c1 = 0.
c2 = thr4
if( age_spec(i).lt.(rot(specnr(i))-15)) then
CALL thinning(c1,c2,actspec,i)
flag_manreal = 1
maninf = 'thinning'
meas = thr4
thinyear(actspec) = time
!wpm
call input_manrec
flag_adapm = 1
end if
ENDIF
END IF
END IF
end if ! thinonce
END IF ! flag_prep
END DO ! species loop
if(maninf.eq.'felling after shelterwood s.') domspec = -99
if(thr7.eq.1 .and.(maninf.eq.'felling after shelterwood s.'.or. &
maninf.eq.'shelterwood system1'.or.maninf.eq.'shelterwood system2') ) then
call input_manrec
maninf =trim(maninf)//'out'
end if
if(flag_sh_first.eq.1) then
shelteryear=time
flag_sh_first = 0
end if
if(maninf.eq.'felling after shelterwood s.') then
domspec = domspec_reg
end if
! regeneration/planting if felling was realised
if(flag_fell.eq.1.and. mgreg.ne.0) then
select case(mgreg)
case(1)
! natural regeneration
flag_reg = 1
! shelterwood management is switched off
thr7 = 0
case(4,5,6,7,8,9,10,11,12,13,14)
! artificial regeneration (planting)
flag_reg = mgreg
call planting
thinyear(actspec) = time
thin_flag2 = 0
thin_flag3 = 0
thin_flag4 = 0
flag_reg = 0
domspec = domspec_reg
end select
end if
! calculation of total dry mass of all harvested trees
sumvsab = 0.
sumvsab_m3 = 0.
svar%sumvsab = 0.
if(maninf.ne.'tending'.or. flag_brush.eq.0) then
zeig=>pt%first
do while (associated(zeig))
ns = zeig%coh%species
sumvsab = sumvsab + zeig%coh%ntreem*(zeig%coh%x_sap + zeig%coh%x_hrt)
sumvsab_m3 = sumvsab_m3 + zeig%coh%ntreem*(zeig%coh%x_sap + zeig%coh%x_hrt)/(spar(ns)%prhos*1000000)
svar(ns)%sumvsab = svar(ns)%sumvsab + zeig%coh%ntreem*(zeig%coh%x_sap + zeig%coh%x_hrt)
zeig=>zeig%next
end do
sumvsab = sumvsab * 10000./kpatchsize ! kg/ha
sumvsab_m3 = sumvsab_m3 * 10000./kpatchsize ! kg/ha
do k = 1, nspec_tree
svar(k)%sumvsab = svar(k)%sumvsab * 10000./kpatchsize ! kg/ha
end do
! cumulative harvested stem mass
cumsumvsab = cumsumvsab + sumvsab
end if
call class_man
END SUBROUTINE adap_manag
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! management routine with fitting stem biomass on target values of stem biomass
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE target_manag
USE data_manag
USE data_stand
USE data_species
USE data_simul
implicit none
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
zeig=>pt%first
do
if(.not.associated(zeig)) exit
if(zeig%coh%species.le.nspec_tree) then
stand_age = zeig%coh%x_age
taxnr = zeig%coh%species
exit
end if
zeig => zeig%next
end do
! stand manamgent at rotaiotn age
if(taxnr.le.nspec_tree) then
if(stand_age.ne.0) then
select case(thr7)
case(1) ! shelterwood manamgent
case(2) ! clear felling
if(stand_age.eq.(rot(taxnr)-15)) then
zeig=>pt%first
do
if(.not.associated(zeig)) exit
if(zeig%coh%species.eq.taxnr) zeig%coh%shelter = 1
zeig=>zeig%next
end do
return
else if (stand_age.ge.rot(taxnr)) then
call felling(taxnr,i)
flag_manreal = 1
maninf = 'felling'
meas =0
call input_manrec
select case(mgreg)
case(1)
! natural regeneration
flag_reg = 1
! shelterwood management is switched off
thr7 = 0
case(10,11,12,13)
! modification for muilti-run option BRB
if(taxnr.eq.1) then
flag_reg = 11
else if(taxnr.eq.2) then
flag_reg = 13
else if(taxnr.eq.3) then
flag_reg = 10
else if (taxnr.eq.4) then
flag_reg = 12
else
flag_reg = 14
! artificial regeneration (planting)
call planting
flag_reg = 0
end select ! mgreg
end if
end select ! thr7
end if
do j= 1, thin_nr
if(time .eq.thin_year(j)) then
if(thin_stor(j).eq.1.) then
select case(mgreg)
case(1)
! natural regeneration
flag_reg = 1
! Achtung hier ändern!!!
case(8,10,11,12,13, 14, 17)
! artificial regeneration (planting)
zeig=>pt%first
do
if(.not.associated(zeig)) exit
zeig%coh%underst = 0
zeig=>zeig%next
end do
flag_reg = mgreg
call planting
flag_reg = 0
end select ! mgreg
end if ! regeneration & planting
if (flag_mg.eq.3) then
call target_thinning(j)
else if (flag_mg.eq.333) then
call target_thinning_bas(j)