!*****************************************************************!
!*                                                               *!
!*              4C (FORESEE) Simulation Model                    *!
!*                                                               *!
!*                                                               *!
!*                    Subroutines for:                           *!
!*                  - output routines -                          *!
!*          Specific files written from model subroutines        *!
!*                                                               *!
!*   contains                                                    *!
!*   OLD_OUT:      Initialization of output files  ("private")   *!
!*   OUT_ASS:      file output ("private")                       *!
!*   OUT_ALL:      output for monitoring allocation              *!
!*   OUTTEST:      test of output flags                          *!
!*   OUTTEST_YEAR: test of output flags - yearly output          *!
!*   OUTTEST_DAY:  test of output flags - daily output           *!
!*   OUTTEST_COH:  test of output flags - cohort output          *!
!*                                                               *!
!*                  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 old_out

 use data_out
 use data_simul

 implicit none

 INTEGER help_ip
 CHARACTER(100) ::filename

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

! open output files & write column headers
if (time_out .gt. 0) then
   if (out_flag_light .ne. 0) then
      unit_light=getunit()
      filename = trim(site_name(help_ip))//'_light.res'//trim(anh)
      OPEN (unit_light, file=trim(dirout)//filename, status = 'UNKNOWN')
      WRITE (unit_light, '(A)') 'year coh totFAPR   LAI   '
   endif

   if (flag_cohout .eq. 2) then
      unit_prod = getunit()
      filename = trim(site_name(help_ip))//'_prod.res'//trim(anh)
      OPEN (unit_prod, file=trim(dirout)// filename, status = 'UNKNOWN')
      WRITE (unit_prod, '(A)') ' year  day  coh         PAR     totFPAR         LUE         NPP      netAss    grossAss     nDaysPS'
      unit_allo = getunit()
      filename = trim(site_name(help_ip))//'_allo.res'//trim(anh)
      OPEN (unit_allo, file=trim(dirout)//filename, status = 'UNKNOWN')
      WRITE (unit_allo, '(A)') ' year  coh   ntree        NPP        dbh growthrate       Fnew       Fmax      Htnew&
                              &    lambdaf    lambdas    lambdar    lambdac         x1         x2'
   endif
endif

   IF (flag_dayout .ge. 2) THEN
      unit_wat = getunit()
      filename = trim(site_name(help_ip))//'_water.res'//trim(anh)
      OPEN (unit_wat, file=trim(dirout)//filename, status = 'UNKNOWN')
      WRITE (unit_wat, '(A)') ' Year Iday   Temp   Prec Interc Int_st  Int_s I_st_s   Snow Snow_sm     PET TRA_DEM&
                              &     PEV   AEV_s   AEV_i  Percol   WAtot   WEtot   WUtot WUtot_e&
                              & WUtot_r Tratree Trasveg EVA_dem  GP_can     AET cep_can  cep_sv'

      unit_soicnd = getunit()
      filename = trim(site_name(help_ip))//'_Nmin.res'//trim(anh)
      OPEN (unit_soicnd, file=trim(dirout)//filename, status = 'UNKNOWN')
      WRITE (unit_soicnd, '(A)') ' Year Iday     N_min_1     N_min_2     N_min_3     N_min_4     N_min_5     N_min_6 ... '

      unit_soicna = getunit()
      filename = trim(site_name(help_ip))//'_remin.res'//trim(anh)
      OPEN (unit_soicna, file=trim(dirout)// filename, status = 'UNKNOWN')
      WRITE (unit_soicna, '(A)') ' Year Iday    remin_1     remin_2     remin_3     remin_4     remin_5     remin_6'

     unit_soicnr = getunit()
      filename = trim(site_name(help_ip))//'_rmin.res'//trim(anh)
      OPEN (unit_soicnr, file=trim(dirout)// filename, status = 'UNKNOWN')
      WRITE (unit_soicnr, '(A)') ' Year Iday    rmin_t     rmin_w     rmin_phv'

   ENDIF

END SUBROUTINE old_out

!**************************************************************

SUBROUTINE OUT_ASS(ident,PAR,NPP,totFPAR,LUE,netass,grossass,ndaysps)

  USE data_simul
  USE data_out

  IMPLICIT NONE

  REAL :: temp, dayL, PAR, netAss, grossass, maintResp, NPP, totFPAR, sapresp, coarseresp, frtresp, assi, resp, LUE, ndaysps
  integer :: ident

  WRITE(unit_prod, '(3I5,6E12.4,F6.1)') time_cur,iday,ident, PAR,totFPAR,LUE,NPP,netAss,grossass, ndaysps

END SUBROUTINE OUT_ASS

!**************************************************************

SUBROUTINE OUT_ALL( ident, ntree, NPP, DBH, grate, Fnew,Fmax_old,Htnew, lf,ls,lr,lc,x1,x2 )

  !*** Declaration part ***!

  USE data_out
  USE data_simul
  USE data_stand

  IMPLICIT NONE

  INTEGER :: ident
  REAL  ::  ntree, NPP, DBH, lf, ls, lr, lc, x1, x2, grate,Fnew,Fmax_old,Htnew

  !*** Calculation part ***!

  WRITE( unit_allo, '(2I5,F8.0,12F11.4)' ) time_cur, ident, ntree, NPP, DBH,grate,Fnew,Fmax_old,Htnew, lf,ls,lr,lc,x1,x2

END SUBROUTINE out_all

!**************************************************************

SUBROUTINE outtest

use data_out
use data_simul

implicit none

integer hflag, j, i
logical testflag
character a

call outtest_year
call outtest_day
call outtest_coh
call outtest_end

END subroutine outtest

!**************************************************************

SUBROUTINE outtest_year

use data_out
use data_simul

implicit none

integer i, j
logical testflag
character a

IF (time_out > 0 ) then
   if (nyvar .eq. 1) then
      do i = 1,outy_n
         SELECT CASE (outy(i)%kind_name)

         CASE ('litter')
            outy(i)%out_flag = 2

         CASE ('soil')
            outy(i)%out_flag = 2

         CASE DEFAULT
            outy(i)%out_flag = 1
         end select
      enddo
   else
      outy%out_flag = 0
      do j = 1,nyvar-1
         testflag = .TRUE.
         do i = 1,outy_n
            if (trim(outy_file(j)) .eq. trim(outy(i)%kind_name)) then
               SELECT CASE (outy(i)%kind_name)
               CASE ('litter')
                  outy(i)%out_flag = 2
               CASE ('soil')
                  outy(i)%out_flag = 2
               CASE DEFAULT
                  outy(i)%out_flag = 1
               end select
			   testflag = .FALSE.
			   exit
			endif
         enddo
		 if (testflag .and. trim(outy_file(j)) .ne. 'end') then
		    print *
            print *,' >>>FORESEE message: Invalid output file name: '//trim(outy_file(j))
		    print *
         endif
      enddo
   endif  ! nyvar

   IF (year/time_out > 500) then
       print *,' '
       write(*,*)'  Warning: Your choice of yearly output steps will create'
       write(*,'(I8,A)') year/time_out, ' data records per file!'
       write(*,'(A)',advance='no')'  Do you really want to use this value (y/n)? '
       read *,a
          IF (a .eq. 'n' .or. a .eq. 'N') then
           write(*,'(A)',advance='no')'  New value of time distance for yearly output: '
           read *, time_out
          ENDIF
   ENDIF
ELSE
   do i = 1,outy_n
      outy(i)%out_flag = 0
   enddo
ENDIF   ! time_out > 0 

END SUBROUTINE outtest_year

!**************************************************************

SUBROUTINE outtest_day

use data_out
use data_simul

implicit none

integer i, j
logical testflag
character a

! daily output
IF (flag_dayout > 0 ) then
   if (ndvar .eq. 1) then
      do i = 1,outd_n
         outd(i)%out_flag = 1
      enddo
   else
      outd%out_flag = 0
      do j = 1,ndvar-1
         testflag = .TRUE.
         do i = 1,outd_n
            if (trim(outd_file(j)) .eq. trim(outd(i)%kind_name)) then
               outd(i)%out_flag = 1
			   testflag = .FALSE.
			   exit
			endif
         enddo
		 if (testflag .and. trim(outd_file(j)) .ne. 'end') then
		    print *
            print *,' >>>FORESEE message: Invalid output file name: '//trim(outd_file(j))
		    print *
         endif
      enddo
   endif  ! ndvar
else
   do i = 1,outd_n
      outd(i)%out_flag = 0
   enddo
endif

END SUBROUTINE outtest_day

!**************************************************************

SUBROUTINE outtest_coh

use data_out
use data_simul

implicit none

integer i, j
logical testflag

! cohort output
SELECT CASE (flag_cohout)
CASE (0)
   ! flags of all daily cohort files
   do i = 1,outcd_n
      outcd(i)%out_flag = 0
   enddo

   ! flags of all yearly cohort files
   do i = 1,outcy_n
      outcy(i)%out_flag = 0
   enddo
   flag_cohoutd = 0
   flag_cohouty = 0

CASE (1,2)
   if (ncvar .eq. 1) then
!    yearly cohort output
      if (time_out .gt. 0) then
        do i = 1,outcy_n
          select case (outcy(i)%kind_name)
          case ('dtr')
            outcy(i)%out_flag = 2
          case ('trman')
            outcy(i)%out_flag = 2
          case default
            outcy(i)%out_flag = 1
          end select
        enddo
        flag_cohouty   = 1
      else
	    outcy%out_flag = 0
        flag_cohouty   = 0
	  endif

!    daily cohort output
      if (flag_dayout .gt. 0) then
        do i = 1,outcd_n
          select case (outcd(i)%kind_name)
          case ('dips')
            outcd(i)%out_flag = 2
          case ('gsdps')
            outcd(i)%out_flag = 2
          case default
            outcd(i)%out_flag = 1
          end select
        enddo
      else
	     outcd%out_flag = 0
	  endif
   else
      outcy%out_flag = 0
      outcd%out_flag = 0
      flag_cohoutd = 0
      flag_cohouty = 0
      do j = 1,ncvar-1
         testflag = .TRUE.
         do i = 1,outcy_n
            if (trim(outc_file(j)) .eq. trim(outcy(i)%kind_name)) then
               select case (outcy(i)%kind_name)
               case ('dtr')
                 outcy(i)%out_flag = 2
               case ('trman')
                 outcy(i)%out_flag = 2
               case default
                 outcy(i)%out_flag = 1
               end select
			   testflag = .FALSE.
               flag_cohouty = 1
			   exit
			endif
         enddo
         if (testflag .and. flag_dayout .gt. 0) then
           do i = 1,outcd_n
              if (trim(outc_file(j)) .eq. trim(outcd(i)%kind_name)) then
                 select case (outcd(i)%kind_name)
                 case ('dips')
                   outcd(i)%out_flag = 2
                 case ('gsdps')
                   outcd(i)%out_flag = 2
                 case default
                   outcd(i)%out_flag = 1
                 end select
			     testflag = .FALSE.
                 flag_cohouty = 1
			     exit
		      endif
           enddo
         endif
		 if (testflag .and. trim(outd_file(j)) .ne. 'end') then
		    print *
            print *,' >>>FORESEE message: Invalid output file name: '//trim(outd_file(j))
		    print *
         endif
      enddo
   endif  ! ncvar
END SELECT

if (flag_cohout .eq. 2) then
   out_flag_light = 1
else
   out_flag_light = 0
endif

END SUBROUTINE outtest_coh

!**************************************************************

SUBROUTINE outtest_end

use data_out
use data_simul

implicit none

integer i, j
if (flag_wpm == 1 .or. flag_wpm == 21 .or. flag_wpm == 11.or.flag_wpm== 5.or. flag_wpm == 4 .or. flag_wpm == 6) then
	do i = 1,oute_n
	  select case (oute(i)%kind_name)
	  case ('wpm')
		oute(i)%out_flag = 1
	  case ('wpm_inter')
		oute(i)%out_flag = 1
	  end select
	enddo
else if (flag_wpm == 2) then
	do i = 1,oute_n
	  select case (oute(i)%kind_name)
	  case ('sea')
		oute(i)%out_flag = 1
	  case ('sea_npv')
		oute(i)%out_flag = 1
	  case ('sea_ms')
		oute(i)%out_flag = 1
	  case ('sea_st')
		oute(i)%out_flag = 1

	  end select
	enddo
else if(flag_wpm.eq.3) then
	do i = 1,oute_n
	  select case (oute(i)%kind_name)
	  case ('sea')
		oute(i)%out_flag = 1
	  case ('sea_npv')
		oute(i)%out_flag = 1
	  case ('sea_ms')
		oute(i)%out_flag = 1
	  case ('sea_st')
		oute(i)%out_flag = 1
	  case ('wpm')
		oute(i)%out_flag = 1
	  case ('wpm_inter')
		oute(i)%out_flag = 1

	  end select
	enddo

else
	do i = 1,oute_n
		oute(i)%out_flag = 0
	enddo
endif


END SUBROUTINE outtest_end
