diff --git a/source_code/version2.2_windows/win_appl_path.f90 b/source_code/version2.2_windows/win_appl_path.f90 new file mode 100644 index 0000000000000000000000000000000000000000..0fa1319c02596479f577877264b4410708ac180c --- /dev/null +++ b/source_code/version2.2_windows/win_appl_path.f90 @@ -0,0 +1,150 @@ +!*****************************************************************! +!* *! +!* 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 +