win_appl_path.f90

!*****************************************************************!
!*                                                               *!
!*              4C (FORESEE) Simulation Model                    *!
!*                                                               *!
!*                    Subroutines for:                           *!
!*                   - windows shell -                           *!
!*                                                               *!
!*  contains:                                                    *!
!*   Act_Dir                                                     *!
!*   winPath                                                     *!
!*   dealofile                                                   *!
!*   fullPath                                                    *!
!*                                                               *!
!*                  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/XXXXXXXXXXXXXXXXXXXXX     *!
!*                                                               *!
!*****************************************************************!
    
SUBROUTINE Act_Dir (dir)

!  Program to demonstrate GETDRIVEDIRQQ
use IFPORT
!USE DFLIB ! In case QuickWin is used
CHARACTER(150) dir
INTEGER(4) length

!  Get current directory
dir = FILE$CURDRIVE

length = GETDRIVEDIRQQ(dir)

IF (length .GT. 0) THEN
  WRITE (*,*) 'Current directory is: '
  WRITE (*,*) dir
ELSE
  WRITE (*,*) 'Failed to get current directory'
END IF

END SUBROUTINE Act_Dir

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

subroutine winPath()

use data_mess
use data_simul

implicit none

integer ind, i

	! set full path for the files	
	ind = index(actDir, '\', .TRUE.)
	! go to ..
	if ( 'input' == trim(actDir(ind+1:ind+5)) ) then
		dirout = trim(actDir(1:ind))//'output\'
	! stay in the directory
	else
		dirout = trim(actdir)//'\output\' 
	endif

	do i = 1,site_nr 
        call fullPath( sitefile(i) , actDir)
        call fullPath( treefile(i) , actDir)
	end do

    if (.not.flag_mult910) then
	    do i = 1,site_nr 
		    call fullPath( specfile(i) , actDir)
		    call fullPath( climfile(i) , actDir)
            call fullPath( valfile(i)  , actDir)
            call fullPath( manfile(i)  , actDir)
            call fullPath( depofile(i) , actDir)
            call fullPath( redfile(i)  , actDir)
            call fullPath( litfile(i)  , actDir)
		    
		    ! till the wpm files is set
		    wpmfile(i) = 'dummy.wpm'
		    call fullPath( wpmfile(i)  , actDir)	
	    end do
    else
		call fullPath( specfile(1) , actDir)
        call fullPath( manfile(1)  , actDir)
        call fullPath( depofile(1) , actDir)
        call fullPath( redfile(1)  , actDir)
        call fullPath( litfile(1)  , actDir)

    endif

    if (allocated(mesfile)) call fullPath( mesfile(1)  , actDir)	

end subroutine winPath
    
!**************************************************************

SUBROUTINE deallofile

use data_simul

implicit none

    if ( allocated(site_name) ) deallocate(site_name)

    if ( allocated(climfile) ) deallocate(climfile)

    if ( allocated(sitefile) ) deallocate(sitefile)

    if ( allocated(valfile) ) deallocate(valfile)

    if ( allocated(treefile) ) deallocate(treefile)
	if ( allocated(wpmfile) ) deallocate(wpmfile)
    if ( allocated(standid) ) deallocate(standid)
    if ( allocated(manfile) ) deallocate(manfile)
    if ( allocated(depofile) ) deallocate(depofile)
    if ( allocated(redfile) ) deallocate(redfile)
    if ( allocated(litfile) ) deallocate(litfile)
	if ( allocated(specfile) ) deallocate(specfile)
	
	site_nr = 1

end subroutine deallofile

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

! changes "input\..." filename into absolute path filename
subroutine fullPath(filename, dir)
	
character(150) dir, filename
integer ind

	if ('input' == filename(1:5)) then

		! Problem: input/input
		ind = index(dir, '\', .TRUE.)
		if ( 'input' == trim(dir(ind+1:ind+5)) ) then
			ind = index(filename, '/', .TRUE.)
			filename = trim(dir)//trim(filename(ind:))
		else
			filename = trim(dir)//'\'//trim(filename)
		end if
	end if

end subroutine fullPath