Eine Neue Datei hochladen

source_code/version2.2_windows/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
+