Skip to content

Commit

Permalink
Merge branch 'master' of https://github.com/AquaticEcoDynamics/libaed2
Browse files Browse the repository at this point in the history
  • Loading branch information
@matthipsey
matthipsey committed May 13, 2020
2 parents d5c203c + bbcfd0a commit fd8a9f3
Show file tree
Hide file tree
Showing 3 changed files with 294 additions and 17 deletions.
128 changes: 117 additions & 11 deletions src/aed2_phytoplankton.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -51,12 +51,14 @@ MODULE aed2_phytoplankton
! aed2_phytoplankton --- phytoplankton biogeochemical model
!-------------------------------------------------------------------------------
USE aed2_core
USE aed2_util,ONLY : find_free_lun, &
exp_integral, &
aed2_bio_temp_function, &
fTemp_function, &
water_viscosity, &
in_zone_set
! USE aed2_util,ONLY : find_free_lun, &
! exp_integral, &
! aed2_bio_temp_function, &
! fTemp_function, &
! water_viscosity, &
! in_zone_set,
! CSV_TYPE, NML_TYPE
USE aed2_util
USE aed2_bio_utils

IMPLICIT NONE
Expand Down Expand Up @@ -122,6 +124,103 @@ MODULE aed2_phytoplankton
CONTAINS


!###############################################################################
INTEGER FUNCTION load_csv(dbase,pd)
!-------------------------------------------------------------------------------
USE aed2_csv_reader
!-------------------------------------------------------------------------------
!ARGUMENTS
CHARACTER(len=*),INTENT(in) :: dbase
TYPE(phyto_nml_data) :: pd(MAX_PHYTO_TYPES)
!
!LOCALS
INTEGER :: unit, nccols, ccol
CHARACTER(len=32),POINTER,DIMENSION(:) :: csvnames
CHARACTER(len=32) :: name
TYPE(AED_SYMBOL),DIMENSION(:),ALLOCATABLE :: values
INTEGER :: idx_col = 0
LOGICAL :: meh
INTEGER :: ret = 0
!
!BEGIN
!-------------------------------------------------------------------------------
unit = aed_csv_read_header(dbase, csvnames, nccols)
IF (unit <= 0) THEN
load_csv = -1
RETURN !# No file found
ENDIF

ALLOCATE(values(nccols))

DO WHILE ( aed_csv_read_row(unit, values) )
DO ccol=2,nccols
pd(ccol)%p_name = csvnames(ccol)

CALL copy_name(values(1), name)
SELECT CASE (name)
CASE ('p0') ; pd(ccol)%p0 = extract_double(values(ccol))
CASE ('w_p') ; pd(ccol)%w_p = extract_double(values(ccol))
CASE ('Xcc') ; pd(ccol)%Xcc = extract_double(values(ccol))
CASE ('R_growth') ; pd(ccol)%R_growth = extract_double(values(ccol))
CASE ('fT_Method') ; pd(ccol)%fT_Method = extract_integer(values(ccol))
CASE ('theta_growth') ; pd(ccol)%theta_growth = extract_double(values(ccol))
CASE ('T_std') ; pd(ccol)%T_std = extract_double(values(ccol))
CASE ('T_opt') ; pd(ccol)%T_opt = extract_double(values(ccol))
CASE ('T_max') ; pd(ccol)%T_max = extract_double(values(ccol))
CASE ('lightModel') ; pd(ccol)%lightModel = extract_integer(values(ccol))
CASE ('I_K') ; pd(ccol)%I_K = extract_double(values(ccol))
CASE ('I_S') ; pd(ccol)%I_S = extract_double(values(ccol))
CASE ('KePHY') ; pd(ccol)%KePHY = extract_double(values(ccol))
CASE ('f_pr') ; pd(ccol)%f_pr = extract_double(values(ccol))
CASE ('R_resp') ; pd(ccol)%R_resp = extract_double(values(ccol))
CASE ('theta_resp') ; pd(ccol)%theta_resp = extract_double(values(ccol))
CASE ('k_fres') ; pd(ccol)%k_fres = extract_double(values(ccol))
CASE ('k_fdom') ; pd(ccol)%k_fdom = extract_double(values(ccol))
CASE ('salTol') ; pd(ccol)%salTol = extract_integer(values(ccol))
CASE ('S_bep') ; pd(ccol)%S_bep = extract_double(values(ccol))
CASE ('S_maxsp') ; pd(ccol)%S_maxsp = extract_double(values(ccol))
CASE ('S_opt') ; pd(ccol)%S_opt = extract_double(values(ccol))
CASE ('simDINUptake') ; pd(ccol)%simDINUptake = extract_integer(values(ccol))
CASE ('simDONUptake') ; pd(ccol)%simDONUptake = extract_integer(values(ccol))
CASE ('simNFixation') ; pd(ccol)%simNFixation = extract_integer(values(ccol))
CASE ('simINDynamics') ; pd(ccol)%simINDynamics = extract_integer(values(ccol))
CASE ('N_o') ; pd(ccol)%N_o = extract_double(values(ccol))
CASE ('K_N') ; pd(ccol)%K_N = extract_double(values(ccol))
CASE ('X_ncon') ; pd(ccol)%X_ncon = extract_double(values(ccol))
CASE ('X_nmin') ; pd(ccol)%X_nmin = extract_double(values(ccol))
CASE ('X_nmax') ; pd(ccol)%X_nmax = extract_double(values(ccol))
CASE ('R_nuptake') ; pd(ccol)%R_nuptake = extract_double(values(ccol))
CASE ('k_nfix') ; pd(ccol)%k_nfix = extract_double(values(ccol))
CASE ('R_nfix') ; pd(ccol)%R_nfix = extract_double(values(ccol))
CASE ('simDIPUptake') ; pd(ccol)%simDIPUptake = extract_integer(values(ccol))
CASE ('simIPDynamics') ; pd(ccol)%simIPDynamics = extract_integer(values(ccol))
CASE ('P_0') ; pd(ccol)%P_0 = extract_double(values(ccol))
CASE ('K_P') ; pd(ccol)%K_P = extract_double(values(ccol))
CASE ('X_pcon') ; pd(ccol)%X_pcon = extract_double(values(ccol))
CASE ('X_pmin') ; pd(ccol)%X_pmin = extract_double(values(ccol))
CASE ('X_pmax') ; pd(ccol)%X_pmax = extract_double(values(ccol))
CASE ('R_puptake') ; pd(ccol)%R_puptake = extract_double(values(ccol))
CASE ('simSiUptake') ; pd(ccol)%simSiUptake = extract_integer(values(ccol))
CASE ('Si_0') ; pd(ccol)%Si_0 = extract_double(values(ccol))
CASE ('K_Si') ; pd(ccol)%K_Si = extract_double(values(ccol))
CASE ('X_sicon') ; pd(ccol)%X_sicon = extract_double(values(ccol))

CASE DEFAULT ; print *, 'Unknown row "', TRIM(name), '"'
END SELECT
ENDDO
ENDDO

meh = aed_csv_close(unit)
!# don't care if close fails

IF (ASSOCIATED(csvnames)) DEALLOCATE(csvnames)
IF (ALLOCATED(values)) DEALLOCATE(values)

load_csv = ret
END FUNCTION load_csv
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


!###############################################################################
SUBROUTINE aed2_phytoplankton_load_params(data, dbase, count, list, settling, resuspension)
!-------------------------------------------------------------------------------
Expand All @@ -142,11 +241,18 @@ SUBROUTINE aed2_phytoplankton_load_params(data, dbase, count, list, settling, re
NAMELIST /phyto_data/ pd
!-------------------------------------------------------------------------------
!BEGIN
tfil = find_free_lun()
open(tfil,file=dbase, status='OLD', iostat=status)
IF (status /= 0) STOP 'Cannot open phyto_data namelist file'
read(tfil,nml=phyto_data,iostat=status)
close(tfil)
SELECT CASE (param_file_type(dbase))
CASE (CSV_TYPE)
status = load_csv(dbase, pd)
CASE (NML_TYPE)
tfil = find_free_lun()
open(tfil,file=dbase, status='OLD',iostat=status)
IF (status /= 0) STOP 'Cannot open phyto_data namelist file'
read(tfil,nml=phyto_data,iostat=status)
close(tfil)
CASE DEFAULT
print *,'Unknown file type "',TRIM(dbase),'"'; status=1
END SELECT
IF (status /= 0) STOP 'Error reading namelist phyto_data'

data%num_phytos = count
Expand Down
82 changes: 82 additions & 0 deletions src/aed2_util.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -51,8 +51,11 @@ MODULE aed2_util
PUBLIC aed2_bio_temp_function,fTemp_function, fSal_function
PUBLIC PO4AdsorptionFraction, in_zone_set
PUBLIC InitialTemp, SoilTemp
PUBLIC make_dir_path, param_file_type, CSV_TYPE, NML_TYPE
!

INTEGER, PARAMETER :: CSV_TYPE = 1
INTEGER, PARAMETER :: NML_TYPE = 2

!===============================================================================
CONTAINS
Expand Down Expand Up @@ -1071,5 +1074,84 @@ END SUBROUTINE SoilTemp
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


!###############################################################################
LOGICAL FUNCTION make_dir_path(dir)
!-------------------------------------------------------------------------------
! Create the directory path as specified
!-------------------------------------------------------------------------------
#ifdef __INTEL_COMPILER
USE ifport
#endif
!ARGUMENTS
CHARACTER(*),INTENT(in) :: dir
!LOCALS
INTEGER :: len, i, sys
CHARACTER(len=128) :: d
LOGICAL :: res = .TRUE.
# define DIRSEP "/"
!BEGIN
!-------------------------------------------------------------------------------
len = LEN_TRIM(dir)
!print*,'making dir path at "',TRIM(dir),'"'
d(1:128) = ' '
DO i=1,len
IF ( dir(i:i) == '/' ) THEN
IF ( i > 1 ) THEN
! CALL execute_command_line("mkdir " // TRIM(d), exitstat=sys)
! print*,'making dir at "',TRIM(d),'"'
#ifdef __INTEL_COMPILER
sys = system("mkdir " // TRIM(d))
#else
CALL system("mkdir " // TRIM(d))
#endif
ENDIF
d(i:i) = DIRSEP
ELSE
d(i:i) = dir(i:i)
ENDIF
ENDDO
! MAKEDIRQQ is an intel fortran extension
! MAKEDIRQQ can create only one directory at a time. You cannot create a new
! directory and a subdirectory below it in a single command. MAKEDIRQQ does not
! translate path delimiters. You can use either slash (/) or backslash (\) as
! valid delimiters.
! CALL MAKEDIRQQ(d)
! if not intel ...
! CALL SYSTEM("mkdir "//d)
! but the f2008 standard introduces execute_command_line as a standard way
! however it seems the ifort version we have been using doesnt support it?
make_dir_path = res
END FUNCTION make_dir_path
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


!###############################################################################
INTEGER FUNCTION param_file_type(fname)
!-------------------------------------------------------------------------------
!ARGUMENTS
CHARACTER(*),INTENT(in) :: fname
!LOCALS
INTEGER :: len, i, ic
CHARACTER(len=4) :: ext
!BEGIN
!-------------------------------------------------------------------------------
param_file_type = -1
len = LEN_TRIM(fname)
IF (fname(len-3:len-3) == '.' ) THEN
ext = ' '
DO i=1, 3
ic = ichar(fname(len:len))
IF (ic >= 65 .AND. ic < 90) ext(i:i) = char(ic+32)
len = len - 1
ENDDO

IF (ext == 'csv') THEN
param_file_type = CSV_TYPE
ELSEIF (ext == 'nml') THEN
param_file_type = NML_TYPE
ENDIF
ENDIF
END FUNCTION param_file_type
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

END MODULE aed2_util
101 changes: 95 additions & 6 deletions src/aed2_zooplankton.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -55,7 +55,7 @@ MODULE aed2_zooplankton
! aed2_zooplankton --- multi zooplankton biogeochemical model
!-------------------------------------------------------------------------------
USE aed2_core
USE aed2_util,ONLY : find_free_lun,aed2_bio_temp_function, fTemp_function,qsort
USE aed2_util
USE aed2_zoop_utils

IMPLICIT NONE
Expand Down Expand Up @@ -100,6 +100,88 @@ MODULE aed2_zooplankton
CONTAINS


!###############################################################################
INTEGER FUNCTION load_csv(dbase, zoop_param)
!-------------------------------------------------------------------------------
USE aed2_csv_reader
!-------------------------------------------------------------------------------
!ARGUMENTS
CHARACTER(len=*),INTENT(in) :: dbase
TYPE(type_zoop_params),INTENT(out) :: zoop_param(MAX_ZOOP_TYPES)
!
!LOCALS
INTEGER :: unit, nccols, ccol
CHARACTER(len=32),POINTER,DIMENSION(:) :: csvnames
CHARACTER(len=32) :: name
TYPE(AED_SYMBOL),DIMENSION(:),ALLOCATABLE :: values
INTEGER :: idx_col = 0
LOGICAL :: meh
INTEGER :: ret = 0
!
!BEGIN
!-------------------------------------------------------------------------------
unit = aed_csv_read_header(dbase, csvnames, nccols)
IF (unit <= 0) THEN
load_csv = -1
RETURN !# No file found
ENDIF

ALLOCATE(values(nccols))

DO WHILE ( aed_csv_read_row(unit, values) )
DO ccol=2,nccols
zoop_param(ccol)%zoop_name = csvnames(ccol)

CALL copy_name(values(1), name)
SELECT CASE (name)
CASE ('zoop_initial') ; zoop_param(ccol)%zoop_initial = extract_double(values(ccol))
CASE ('min_zoo') ; zoop_param(ccol)%min_zoo = extract_double(values(ccol))
CASE ('Rgrz_zoo') ; zoop_param(ccol)%Rgrz_zoo = extract_double(values(ccol))
CASE ('fassim_zoo') ; zoop_param(ccol)%fassim_zoo = extract_double(values(ccol))
CASE ('Kgrz_zoo') ; zoop_param(ccol)%Kgrz_zoo = extract_double(values(ccol))
CASE ('theta_grz_zoo') ; zoop_param(ccol)%theta_grz_zoo = extract_double(values(ccol))
CASE ('Rresp_zoo') ; zoop_param(ccol)%Rresp_zoo = extract_double(values(ccol))
CASE ('Rmort_zoo') ; zoop_param(ccol)%Rmort_zoo = extract_double(values(ccol))
CASE ('ffecal_zoo') ; zoop_param(ccol)%ffecal_zoo = extract_double(values(ccol))
CASE ('fexcr_zoo') ; zoop_param(ccol)%fexcr_zoo = extract_double(values(ccol))
CASE ('ffecal_sed') ; zoop_param(ccol)%ffecal_sed = extract_double(values(ccol))
CASE ('theta_resp_zoo') ; zoop_param(ccol)%theta_resp_zoo = extract_integer(values(ccol))
CASE ('Tstd_zoo') ; zoop_param(ccol)%Tstd_zoo = extract_integer(values(ccol))
CASE ('Topt_zoo') ; zoop_param(ccol)%Topt_zoo = extract_integer(values(ccol))
CASE ('Tmax_zoo') ; zoop_param(ccol)%Tmax_zoo = extract_integer(values(ccol))
CASE ('saltfunc_zoo') ; zoop_param(ccol)%saltfunc_zoo = extract_integer(values(ccol))
CASE ('Smin_zoo') ; zoop_param(ccol)%Smin_zoo = extract_integer(values(ccol))
CASE ('Smax_zoo') ; zoop_param(ccol)%Smax_zoo = extract_integer(values(ccol))
CASE ('Sint_zoo') ; zoop_param(ccol)%Sint_zoo = extract_integer(values(ccol))
CASE ('INC_zoo') ; zoop_param(ccol)%INC_zoo = extract_double(values(ccol))
CASE ('IPC_zoo') ; zoop_param(ccol)%IPC_zoo = extract_double(values(ccol))
CASE ('DOmin_zoo') ; zoop_param(ccol)%DOmin_zoo = extract_double(values(ccol))
CASE ('Cmin_grz_zoo') ; zoop_param(ccol)%Cmin_grz_zoo = extract_double(values(ccol))
CASE ('num_prey') ; zoop_param(ccol)%num_prey = extract_integer(values(ccol))

CASE ('prey(1)%zoop_prey') ; CALL copy_name(values(ccol), zoop_param(ccol)%prey(1)%zoop_prey)
CASE ('prey(1)%Pzoo_prey') ; zoop_param(ccol)%prey(1)%Pzoo_prey = extract_double(values(ccol))
CASE ('prey(2)%zoop_prey') ; CALL copy_name(values(ccol), zoop_param(ccol)%prey(3)%zoop_prey)
CASE ('prey(2)%Pzoo_prey') ; zoop_param(ccol)%prey(2)%Pzoo_prey = extract_double(values(ccol))
CASE ('prey(3)%zoop_prey') ; CALL copy_name(values(ccol), zoop_param(ccol)%prey(3)%zoop_prey)
CASE ('prey(3)%Pzoo_prey') ; zoop_param(ccol)%prey(3)%Pzoo_prey = extract_double(values(ccol))

CASE DEFAULT ; print *, 'Unknown row "', TRIM(name), '"'
END SELECT
ENDDO
ENDDO

meh = aed_csv_close(unit)
!# don't care if close fails

IF (ASSOCIATED(csvnames)) DEALLOCATE(csvnames)
IF (ALLOCATED(values)) DEALLOCATE(values)

load_csv = ret
END FUNCTION load_csv
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


!###############################################################################
SUBROUTINE aed2_zooplankton_load_params(data, dbase, count, list)
!-------------------------------------------------------------------------------
Expand All @@ -119,11 +201,18 @@ SUBROUTINE aed2_zooplankton_load_params(data, dbase, count, list)
NAMELIST /zoop_params/ zoop_param
!-------------------------------------------------------------------------------
!BEGIN
tfil = find_free_lun()
open(tfil,file=dbase, status='OLD',iostat=status)
IF (status /= 0) STOP 'Error opening zoop_params namelist file'
read(tfil,nml=zoop_params,iostat=status)
close(tfil)
SELECT CASE (param_file_type(dbase))
CASE (CSV_TYPE)
status = load_csv(dbase, zoop_param)
CASE (NML_TYPE)
tfil = find_free_lun()
open(tfil,file=dbase, status='OLD',iostat=status)
IF (status /= 0) STOP 'Error opening zoop_params namelist file'
read(tfil,nml=zoop_params,iostat=status)
close(tfil)
CASE DEFAULT
print *,'Unknown file type "',TRIM(dbase),'"'; status=1
END SELECT
IF (status /= 0) STOP 'Error reading namelist zoop_params'

data%num_zoops = count
Expand Down

0 comments on commit fd8a9f3

Please sign in to comment.