#!/usr/bin/env python #in app_namePara create two files #CMakeLists.txt def Make1layer(sfarm_dir, app_name): print "create file "+sfarm_dir+'/'+app_name+'/'+app_name+'1layer'+"/CMakeLists.txt" fcmake=open(sfarm_dir+'/'+app_name+'/'+app_name+'1layer'+"/CMakeLists.txt","w") fcmake.write("set("+app_name.upper()+"1LAYER_SOURCES\n") fcmake.write(" "+app_name+"BGCIndexType.F90\n") fcmake.write(" "+app_name+"BGCType.F90\n") fcmake.write(")\n") fcmake.write("\n") fcmake.write("include_directories(${CMAKE_BINARY_DIR}/src/betr/betr_util)\n") fcmake.write("include_directories(${CMAKE_BINARY_DIR}/src/betr/betr_math)\n") fcmake.write("include_directories(${CMAKE_BINARY_DIR}/src/Applications/soil-farm/bgcfarm_util)\n") fcmake.write("include_directories(${CMAKE_BINARY_DIR}/src/Applications/soil-farm/"+app_name+"/"+app_name+"Para)\n") fcmake.write("include(add_betr_library)\n") fcmake.write("add_betr_library("+app_name+"1layer ${"+app_name.upper()+"1LAYER_SOURCES})\n") fcmake.write("\n") fcmake.write("set(BETR_LIBRARIES "+app_name+"1layer;${BETR_LIBRARIES} PARENT_SCOPE)\n") fcmake.write("set(BETR_LIBRARIES "+app_name+"1layer;${BETR_LIBRARIES})\n") fcmake.write("\n") #X#add_subdirectory(tests) fcmake.write("if (NOT CMAKE_INSTALL_PREFIX STREQUAL "+'"'+"INSTALL_DISABLED"+'"'+")\n") fcmake.write(" install(TARGETS "+app_name+"1layer DESTINATION lib)\n") fcmake.write(" file(GLOB HEADERS *.h)\n") fcmake.write(" install(FILES ${HEADERS} DESTINATION include/soil-farm/"+app_name+"/"+app_name+"1layer)\n") fcmake.write("endif()\n") fcmake.close() print "create file "+sfarm_dir+'/'+app_name+'/'+app_name+'1layer'+"/"+app_name+"BGCIndexType.F90" ff90=open(sfarm_dir+'/'+app_name+'/'+app_name+'1layer'+"/"+app_name+"BGCIndexType.F90","w") ff90.write("module "+app_name+"BGCIndexType\n") ff90.write(" use bshr_kind_mod , only : r8 => shr_kind_r8\n") ff90.write(" use betr_ctrl , only : spinup_state => betr_spinup_state\n") ff90.write(" use gBGCIndexType , only : gbgc_index_type\n") ff90.write(" use betr_varcon , only : var_flux_type, var_state_type\n") ff90.write("implicit none\n") ff90.write("private\n") ff90.write(" character(len=*), private, parameter :: mod_filename = &\n") ff90.write(" __FILE__\n") ff90.write("\n") ff90.write("integer, parameter :: loc_name_len=64\n") ff90.write("\n") ff90.write(" type, public, extends(gbgc_index_type) :: "+app_name+"_bgc_index_type\n") ff90.write(" integer :: lit1, lit1_depoly_reac\n") ff90.write(" integer :: lit2, lit2_depoly_reac\n") ff90.write(" integer :: lit3, lit3_depoly_reac\n") ff90.write(" integer :: cwd , cwd_depoly_reac\n") ff90.write(" integer :: lid_n2\n") ff90.write(" integer :: lid_o2 , o2_resp_reac\n") ff90.write(" integer :: lid_ar\n") ff90.write(" integer :: lid_co2\n") ff90.write(" integer :: lid_c13_co2\n") ff90.write(" integer :: lid_c14_co2\n") ff90.write(" integer :: lid_ch4\n") ff90.write(" integer :: lid_dom, dom_uptake_reac\n") ff90.write(" integer :: lid_cue, micbd_depoly_reac\n") ff90.write(" integer :: lid_micbl, lid_micbd, micbl_mort_reac\n") ff90.write(" !diagnostic variables\n") ff90.write(" integer :: lid_co2_hr\n") ff90.write(" integer :: lid_o2_paere\n") ff90.write(" integer :: lid_n2_paere\n") ff90.write(" integer :: lid_ar_paere\n") ff90.write(" integer :: lid_co2_paere\n") ff90.write(" integer :: lid_c13_co2_paere\n") ff90.write(" integer :: lid_c14_co2_paere\n") ff90.write(" integer :: lid_ch4_paere\n") ff90.write(" integer :: litr_beg, litr_end !litr group\n") ff90.write(" integer :: wood_beg, wood_end !wood group\n") ff90.write(" integer :: dom_beg, dom_end !dom group\n") ff90.write(" integer :: pom_beg, pom_end !pom group\n") ff90.write(" integer :: Bm_beg, Bm_end !microbial group\n") ff90.write(" integer :: doc_uptake_reac\n") ff90.write(" integer :: nelms\n") ff90.write(" integer :: c_loc, n_loc, p_loc\n") ff90.write(" integer :: c13_loc, c14_loc\n") ff90.write(" integer :: e_loc\n") ff90.write(" integer :: nom_tot_elms\n") ff90.write(" integer :: nom_pools\n") ff90.write(" integer :: nprimvars !total number of primary variables\n") ff90.write(" integer :: nstvars !number of equations for the state variabile vector\n") ff90.write(" integer :: nreactions\n") ff90.write(" integer , pointer :: primvarid(:) => null()\n") ff90.write(" logical :: debug\n") ff90.write(" character(len=loc_name_len), allocatable :: varnames(:)\n") ff90.write(" character(len=loc_name_len), allocatable :: varunits(:)\n") ff90.write(" character(len=loc_name_len), allocatable :: ompoolnames(:)\n") ff90.write(" integer, allocatable :: vartypes(:)\n") ff90.write(" contains\n") ff90.write(" procedure, public :: Init\n") ff90.write(" procedure, private :: InitPars\n") ff90.write(" procedure, private :: InitAllocate\n") ff90.write(" procedure, private :: set_primvar_reac_ids\n") ff90.write(" end type "+app_name+"_bgc_index_type\n") ff90.write("contains\n") ff90.write("!-----------------------------------------------------------------------\n") ff90.write(" subroutine add_ompool_name(list_name, list_unit, list_pool, prefix, use_c13, use_c14, do_init, vid,uid,pid)\n") ff90.write(" !\n") ff90.write(" !DESCRIPTION\n") ff90.write(" !add organic matter pools to the list\n") ff90.write(" use listMod , only : list_s, list_init, list_insert\n") ff90.write(" implicit none\n") ff90.write(" type(list_s), pointer :: list_name\n") ff90.write(" type(list_s), pointer :: list_unit\n") ff90.write(" type(list_s), pointer :: list_pool\n") ff90.write(" character(len=*), intent(in) :: prefix\n") ff90.write(" logical, intent(in) :: use_c13, use_c14\n") ff90.write(" logical, intent(in) :: do_init\n") ff90.write(" integer, intent(inout) :: vid\n") ff90.write(" integer, intent(inout) :: uid\n") ff90.write(" integer, intent(inout) :: pid\n") ff90.write(" if(do_init)then\n") ff90.write(" call list_init(list_name, trim(prefix)//'_c',vid, itype=var_state_type)\n") ff90.write(" call list_init(list_unit, 'mol C m-3',uid)\n") ff90.write(" call list_init(list_pool, trim(prefix),pid)\n") ff90.write(" else\n") ff90.write(" call list_insert(list_name, trim(prefix)//'_c',vid, itype=var_state_type)\n") ff90.write(" call list_insert(list_unit, 'mol C m-3',uid)\n") ff90.write(" call list_insert(list_pool, trim(prefix),pid)\n") ff90.write(" endif\n") ff90.write("\n") ff90.write(" if(use_c13)then\n") ff90.write(" vid=vid+1;call list_insert(list_name, trim(prefix)//'_c13',vid, itype=var_state_type)\n") ff90.write(" vid=vid+1;call list_insert(list_unit, 'mol C13 m-3',uid)\n") ff90.write(" endif\n") ff90.write(" if(use_c14)then\n") ff90.write(" vid=vid+1;call list_insert(list_name, trim(prefix)//'_c14',vid, itype=var_state_type)\n") ff90.write(" vid=vid+1;call list_insert(list_unit, 'mol C14 m-3',uid)\n") ff90.write(" endif\n") ff90.write(" end subroutine add_ompool_name\n") ff90.write(" !-------------------------------------------------------------------------------\n") ff90.write(" subroutine Init(this, use_c13, use_c14, non_limit, nop_limit, maxpft, batch_mode)\n") ff90.write(" !\n") ff90.write(" ! DESCRIPTION:\n") ff90.write(" ! Initialize "+app_name+"_bgc_index_type\n") ff90.write(" ! !USES:\n") ff90.write(" implicit none\n") ff90.write(" ! !ARGUMENTS:\n") ff90.write(" class("+app_name+"_bgc_index_type), intent(inout) :: this\n") ff90.write(" logical, intent(in) :: use_c13\n") ff90.write(" logical, intent(in) :: use_c14\n") ff90.write(" logical, intent(in) :: non_limit\n") ff90.write(" logical, intent(in) :: nop_limit\n") ff90.write(" integer, optional, intent(in) :: maxpft\n") ff90.write(" logical, optional, intent(in) :: batch_mode\n") ff90.write(" ! !LOCAL VARIABLES:\n") ff90.write(" integer :: maxpft_loc\n") ff90.write(" logical :: batch_mode_loc\n") ff90.write(" maxpft_loc = 0\n") ff90.write(" this%dom_beg=0; this%dom_end=-1\n") ff90.write(" if(present(maxpft))maxpft_loc=maxpft\n") ff90.write(" if(present(batch_mode))batch_mode_loc=batch_mode\n") ff90.write(" call this%InitPars(maxpft_loc, use_c14, use_c13, non_limit, nop_limit, batch_mode_loc)\n") ff90.write(" call this%InitAllocate()\n") ff90.write(" this%debug = .false.\n") ff90.write(" end subroutine Init\n") ff90.write("\n") ff90.write(" !-------------------------------------------------------------------------------\n") ff90.write(" subroutine InitPars(this, maxpft, use_c14, use_c13, non_limit, nop_limit, batch_mode)\n") ff90.write(" !\n") ff90.write(" ! !DESCRIPTION:\n") ff90.write(" ! describe the layout of the stoichiometric matrix for the reactions\n") ff90.write(" ! r{1} r{2} r{3} r{4} ... r{n}\n") ff90.write(" ! s{1}\n") ff90.write(" ! s{2}\n") ff90.write(" ! s{3}\n") ff90.write(" ! s{4}\n") ff90.write(" ! ...\n") ff90.write(" ! s{n}\n") ff90.write(" ! s{n+1} nonreactive primary variables\n") ff90.write(" ! s{n+2}\n") ff90.write(" ! ...\n") ff90.write(" ! s{m}\n") ff90.write(" ! s{m+1} diagnostic variables\n") ff90.write(" ! s{p}\n") ff90.write(" ! each reaction is associated with a primary species, the secondary species follows after primary species\n") ff90.write(" !\n") ff90.write(" ! !USES:\n") ff90.write(" use MathfuncMod , only : addone, countelm\n") ff90.write(" use betr_utils , only : num2str\n") ff90.write(" use betr_constants, only : betr_string_length_long\n") ff90.write(" use listMod , only : list_s, copy_name, list_init, list_insert, list_free, copy_name_type\n") ff90.write(" implicit none\n") ff90.write(" class("+app_name+"_bgc_index_type) :: this\n") ff90.write(" integer, intent(in) :: maxpft\n") ff90.write(" logical, intent(in) :: use_c13\n") ff90.write(" logical, intent(in) :: use_c14\n") ff90.write(" logical, intent(in) :: non_limit\n") ff90.write(" logical, intent(in) :: nop_limit\n") ff90.write(" logical, intent(in) :: batch_mode\n") ff90.write(" ! !LOCAL VARIABLES:\n") ff90.write(" integer :: itemp\n") ff90.write(" integer :: ireac !counter of reactions\n") ff90.write(" integer :: itemp0, itemp1\n") ff90.write(" integer :: ielem\n") ff90.write(" integer :: vid,uid,pid\n") ff90.write(" integer :: jj\n") ff90.write(" type(list_s), pointer :: list_name => null()\n") ff90.write(" type(list_s), pointer :: list_unit => null()\n") ff90.write(" type(list_s), pointer :: list_pool => null()\n") ff90.write(" type(list_s), pointer :: list_react=> null()\n") ff90.write(" character(len=loc_name_len) :: postfix\n") ff90.write(" if(maxpft>=0)continue\n") ff90.write(" itemp = 0; itemp0=0\n") ff90.write(" ireac = 0\n") ff90.write(" ielem= 0\n") ff90.write(" vid = 0;uid=0;pid=0\n") ff90.write(" this%c13_loc=0; this%c14_loc=0\n") ff90.write(" this%c_loc = addone(ielem)\n") ff90.write(" if(use_c13)then\n") ff90.write(" this%c13_loc= addone(ielem)\n") ff90.write(" endif\n") ff90.write(" if(use_c14)then\n") ff90.write(" this%c14_loc=addone(ielem)\n") ff90.write(" endif\n") ff90.write(" this%nelms = ielem\n") ff90.write(" this%e_loc = ielem + 1\n") ff90.write("\n") ff90.write(" !litter group\n") ff90.write(" this%litr_beg=1\n") ff90.write(" this%lit1 = addone(itemp);this%lit1_depoly_reac = addone(ireac); call list_init(list_react, 'lit1_depoly_reac', itemp0)\n") ff90.write(" call add_ompool_name(list_name, list_unit, list_pool,'lit1', use_c13, use_c14, do_init=.true., vid=vid,uid=uid,pid=pid)\n") ff90.write(" this%lit2 = addone(itemp);this%lit2_depoly_reac = addone(ireac); call list_insert(list_react, 'lit2_depoly_reac', itemp0)\n") ff90.write(" call add_ompool_name(list_name, list_unit, list_pool,'lit2', use_c13, use_c14, do_init=.false.,vid=vid,uid=uid,pid=pid)\n") ff90.write(" this%lit3 = addone(itemp);this%lit3_depoly_reac = addone(ireac); call list_insert(list_react, 'lit3_depoly_reac', itemp0)\n") ff90.write(" call add_ompool_name(list_name, list_unit, list_pool,'lit3', use_c13, use_c14, do_init=.false.,vid=vid,uid=uid,pid=pid)\n") ff90.write(" this%litr_end = this%litr_beg -1 + (this%lit3-this%lit1+1)*this%nelms\n") ff90.write("\n") ff90.write(" !woody group\n") ff90.write(" this%wood_beg=this%litr_end+1\n") ff90.write(" this%cwd = addone(itemp);this%cwd_depoly_reac = addone(ireac); call list_insert(list_react, 'cwd_depoly_reac', itemp0)\n") ff90.write(" call add_ompool_name(list_name, list_unit, list_pool,'cwd', use_c13, use_c14, do_init=.false., vid=vid,uid=uid,pid=pid)\n") ff90.write(" this%wood_end=this%wood_beg-1+(this%cwd-this%cwd+1)*this%nelms\n") ff90.write("\n") ff90.write(" !microbial biomass group\n") ff90.write(" this%Bm_beg=this%wood_end+1\n") ff90.write(" !modify the code below accordingly\n") ff90.write(" !this%lid_micbl = addone(itemp); this%micbl_mort_reac = addone(ireac); call list_insert(list_react, 'micbl_mort_reac', itemp0)\n") ff90.write(" !call add_ompool_name(list_name, list_unit, list_pool,'MB_live', use_c13, use_c14, do_init=.false., vid=vid,uid=uid,pid=pid)\n") ff90.write(" !this%lid_micbd = addone(itemp); this%micbd_depoly_reac = addone(ireac); call list_insert(list_react, 'micbd_depoly_reac', itemp0)\n") ff90.write(" !call add_ompool_name(list_name, list_unit, list_pool,'MB_dead', use_c13, use_c14, do_init=.false., vid=vid,uid=uid,pid=pid)\n") ff90.write(" !this%Bm_end=this%Bm_beg-1+(this%lid_micbd-this%lid_micbl+1)*this%nelms\n") ff90.write(" this%Bm_end=this%Bm_beg\n") ff90.write(" !DOM, only one pool is defined at this moment\n") ff90.write(" this%dom_beg = this%Bm_end + 1\n") ff90.write(" this%lid_dom = addone(itemp);this%dom_uptake_reac = addone(ireac); call list_insert(list_react, 'dom_uptake_reac', itemp0)\n") ff90.write(" call add_ompool_name(list_name, list_unit, list_pool,'DOC', use_c13, use_c14, do_init=.false., vid=vid,uid=uid,pid=pid)\n") ff90.write(" this%lid_cue = this%lid_dom + 1\n") ff90.write(" call list_insert(list_name, 'DOM_e',vid)\n") ff90.write(" call list_insert(list_unit, 'mol e m-3',uid)\n") ff90.write(" this%dom_end = this%dom_beg - 1 + (this%lid_dom-this%lid_dom+1)*(this%nelms+1)\n") ff90.write("\n") ff90.write(" this%nom_pools = (countelm(this%litr_beg, this%litr_end)+&\n") ff90.write(" countelm(this%wood_beg,this%wood_end) + &\n") ff90.write(" countelm(this%Bm_beg,this%Bm_end))/this%nelms + &\n") ff90.write(" countelm(this%dom_beg,this%dom_end)/(this%nelms+1)\n") ff90.write("\n") ff90.write(" itemp = countelm(this%litr_beg, this%litr_end)+&\n") ff90.write(" countelm(this%wood_beg,this%wood_end) + &\n") ff90.write(" countelm(this%Bm_beg,this%Bm_end) + &\n") ff90.write(" countelm(this%dom_beg,this%dom_end)\n") ff90.write(" this%nom_tot_elms = itemp\n") ff90.write("\n") ff90.write(" !non-reactive primary variables\n") ff90.write(" this%lid_ar = addone(itemp);call list_insert(list_name, 'ar',vid, itype=var_state_type); call list_insert(list_unit, 'mol m-3',uid)\n") ff90.write("\n") ff90.write(" !second primary variables\n") ff90.write(" this%lid_o2 = addone(itemp);call list_insert(list_name, 'o2',vid, itype=var_state_type); call list_insert(list_unit, 'mol m-3',uid)\n") ff90.write(" this%o2_resp_reac = addone(ireac); call list_insert(list_react, 'o2_resp_reac', itemp0)\n") ff90.write(" this%lid_co2 = addone(itemp);call list_insert(list_name, 'co2',vid, itype=var_state_type);call list_insert(list_unit,'mol m-3',uid)\n") ff90.write("\n") ff90.write(" if(use_c13)then\n") ff90.write(" this%lid_c13_co2 = addone(itemp);call list_insert(list_name, 'c13_co2',vid, itype=var_state_type);call list_insert(list_unit,'mol m-3',uid)\n") ff90.write(" endif\n") ff90.write(" if(use_c14)then\n") ff90.write(" this%lid_c14_co2 = addone(itemp);call list_insert(list_name, 'c14_co2',vid, itype=var_state_type);call list_insert(list_unit,'mol m-3',uid)\n") ff90.write(" endif\n") ff90.write("\n") ff90.write(" this%lid_n2 = addone(itemp);call list_insert(list_name, 'n2',vid, itype=var_state_type); call list_insert(list_unit, 'mol N2 m-3',uid)\n") ff90.write(" this%lid_ch4 = addone(itemp);call list_insert(list_name, 'ch4',vid, itype=var_state_type); call list_insert(list_unit, 'mol ch4 m-3',uid)\n") ff90.write("\n") ff90.write(" this%nprimvars = itemp\n") ff90.write("\n") ff90.write(" this%lid_co2_hr = addone(itemp);call list_insert(list_name, 'co2_hr',vid, itype=var_flux_type); call list_insert(list_unit,'mol m-3 s-1',uid)\n") ff90.write(" this%lid_o2_paere = addone(itemp);call list_insert(list_name, 'o2_paere',vid, itype=var_flux_type); call list_insert(list_unit,'mol m-3 s-1',uid)\n") ff90.write(" this%lid_n2_paere = addone(itemp);call list_insert(list_name, 'n2_paere',vid, itype=var_flux_type); call list_insert(list_unit,'mol m-3 s-1',uid)\n") ff90.write(" this%lid_ar_paere = addone(itemp);call list_insert(list_name, 'ar_paere',vid, itype=var_flux_type); call list_insert(list_unit,'mol m-3 s-1',uid)\n") ff90.write(" this%lid_ch4_paere = addone(itemp);call list_insert(list_name, 'ch4_paere',vid, itype=var_flux_type); call list_insert(list_unit,'mol m-3 s-1',uid)\n") ff90.write(" this%lid_co2_paere = addone(itemp);call list_insert(list_name, 'co2_paere',vid, itype=var_flux_type); call list_insert(list_unit,'mol m-3 s-1',uid)\n") ff90.write(" if(use_c13)then\n") ff90.write(" this%lid_c13_co2_paere = addone(itemp);call list_insert(list_name, 'c13_co2_paere',vid, itype=var_flux_type); call list_insert(list_unit,'mol m-3 s-1',uid)\n") ff90.write(" endif\n") ff90.write(" if(use_c14)then\n") ff90.write(" this%lid_co2_paere = addone(itemp);call list_insert(list_name, 'c14_co2_paere',vid, itype=var_flux_type); call list_insert(list_unit,'mol m-3 s-1',uid)\n") ff90.write(" endif\n") ff90.write(" this%nstvars = itemp\n") ff90.write(" this%nreactions = ireac\n") ff90.write("\n") ff90.write(" allocate(this%primvarid(ireac)); this%primvarid(:) = -1\n") ff90.write(" allocate(this%vartypes(this%nstvars))\n") ff90.write(" allocate(this%varnames(this%nstvars))\n") ff90.write(" allocate(this%varunits(this%nstvars))\n") ff90.write(" allocate(this%ompoolnames(this%nom_pools))\n") ff90.write("\n") ff90.write(" call copy_name(this%nstvars, list_name, this%varnames(1:this%nstvars))\n") ff90.write(" call copy_name(this%nstvars, list_unit, this%varunits(1:this%nstvars))\n") ff90.write(" call copy_name(this%nom_pools, list_pool, this%ompoolnames(1:this%nom_pools))\n") ff90.write(" call copy_name_type(this%nstvars, list_name, this%vartypes(1:this%nstvars))\n") ff90.write(" !call list_disp(list_name); call list_disp(list_pool);call list_disp(list_unit)\n") ff90.write(" call list_free(list_name)\n") ff90.write(" call list_free(list_pool)\n") ff90.write(" call list_free(list_unit)\n") ff90.write(" end subroutine InitPars\n") ff90.write("\n") ff90.write(" !-------------------------------------------------------------------------------\n") ff90.write(" subroutine InitAllocate(this)\n") ff90.write(" !\n") ff90.write(" ! !DESCRIPTION:\n") ff90.write(" ! memory allocation for the data type specified by this\n") ff90.write(" !\n") ff90.write(" implicit none\n") ff90.write(" ! !ARGUMENTS:\n") ff90.write(" class("+app_name+"_bgc_index_type), intent(inout) :: this\n") ff90.write("\n") ff90.write(" if (this%dummy_compiler_warning) continue\n") ff90.write(" end subroutine InitAllocate\n") ff90.write("\n") ff90.write(" !-------------------------------------------------------------------------------\n") ff90.write(" subroutine set_primvar_reac_ids(this)\n") ff90.write(" !\n") ff90.write(" !DESCRIPTION\n") ff90.write(" !set primary variable for each reaction\n") ff90.write(" implicit none\n") ff90.write(" class("+app_name+"_bgc_index_type), intent(inout) :: this\n") ff90.write("\n") ff90.write(" !local variables\n") ff90.write(" integer :: reac\n") ff90.write("\n") ff90.write(" reac=this%lit1_depoly_reac; this%primvarid(reac) = this%lit1\n") ff90.write(" reac=this%lit2_depoly_reac; this%primvarid(reac) = this%lit2\n") ff90.write(" reac=this%lit3_depoly_reac; this%primvarid(reac) = this%lit3\n") ff90.write(" reac=this%cwd_depoly_reac; this%primvarid(reac) = this%cwd\n") ff90.write(" reac=this%micbd_depoly_reac; this%primvarid(reac) = this%lid_micbd\n") ff90.write(" reac=this%micbl_mort_reac; this%primvarid(reac) = this%lid_micbl\n") ff90.write(" reac=this%dom_uptake_reac; this%primvarid(reac) = this%lid_dom\n") ff90.write(" reac=this%o2_resp_reac; this%primvarid(reac) = this%lid_o2\n") ff90.write("\n") ff90.write(" end subroutine set_primvar_reac_ids\n") ff90.write("end module "+app_name+"BGCIndexType\n") ff90.write("\n") ff90.close() print "create file "+sfarm_dir+'/'+app_name+'/'+app_name+'1layer'+"/"+app_name+"BGCType.F90" ff90=open(sfarm_dir+'/'+app_name+'/'+app_name+'1layer'+"/"+app_name+"BGCType.F90","w") ff90.write("module "+app_name+"BGCType\n") ff90.write("#include "+'"'+"bshr_assert.h"+'"\n') ff90.write(" !\n") ff90.write(" ! !DESCRIPTION:\n") ff90.write("\n") ff90.write(" ! !USES:\n") ff90.write(" use bshr_kind_mod , only : r8 => shr_kind_r8\n") ff90.write(" use bshr_log_mod , only : errMsg => shr_log_errMsg\n") ff90.write(" use betr_varcon , only : spval => bspval\n") ff90.write(" use betr_ctrl , only : spinup_state => betr_spinup_state\n") ff90.write(" use gbetrType , only : gbetr_type\n") ff90.write(" use BiogeoConType , only : BiogeoCon_type\n") ff90.write(" use "+app_name+"ParaType , only : "+app_name+"_para_type\n") ff90.write(" use BetrStatusType , only : betr_status_type\n") ff90.write(" use BeTRJarModel , only : jar_model_type\n") ff90.write(" use "+app_name+"BGCIndexType , only : "+app_name+"_bgc_index_type\n") ff90.write(" implicit none\n") ff90.write(" private\n") ff90.write(" character(len=*), private, parameter :: mod_filename = &\n") ff90.write(" __FILE__\n") ff90.write("\n") ff90.write(" type, extends(jar_model_type), public :: "+app_name+"_bgc_type\n") ff90.write(" type("+app_name+"_bgc_index_type), private :: "+app_name+"_index\n") ff90.write(" real(r8), pointer :: ystates0(:)\n") ff90.write(" real(r8), pointer :: ystates1(:)\n") ff90.write(" real(r8), pointer :: scal_f(:)\n") ff90.write(" real(r8), pointer :: conv_f(:)\n") ff90.write(" real(r8), pointer :: conc_f(:)\n") ff90.write(" logical , private :: use_c13\n") ff90.write(" logical , private :: use_c14\n") ff90.write(" logical , private :: batch_mode\n") ff90.write("\n") ff90.write(" !declare parameters below\n") ff90.write("\n") ff90.write(" real(r8), pointer :: cascade_matrix(:,:)\n") ff90.write(" real(r8), pointer :: cascade_matrixd(:,:)\n") ff90.write(" real(r8), pointer :: cascade_matrixp(:,:)\n") ff90.write(" real(r8) :: o2_w2b\n") ff90.write(" contains\n") ff90.write(" procedure, public :: init => init_"+app_name+"\n") ff90.write(" procedure, public :: runbgc => runbgc_"+app_name+"\n") ff90.write(" procedure, public :: UpdateParas => UpdateParas_"+app_name+"\n") ff90.write(" procedure, public :: getvarllen => getvarllen_"+app_name+"\n") ff90.write(" procedure, public :: getvarlist => getvarlist_"+app_name+"\n") ff90.write(" procedure, public :: init_cold => init_cold_"+app_name+"\n") ff90.write(" procedure, private :: arenchyma_gas_transport\n") ff90.write(" procedure, private :: init_states\n") ff90.write(" procedure, private :: add_ext_input\n") ff90.write(" procedure, private :: InitAllocate\n") ff90.write(" procedure, private :: "+app_name+"_rrates\n") ff90.write(" procedure, private :: calc_cascade_matrix\n") ff90.write(" procedure, private :: bgc_integrate\n") ff90.write(" procedure, private :: ode_adapt_ebbks1\n") ff90.write(" end type "+app_name+"_bgc_type\n") ff90.write(" public :: create_jarmodel_"+app_name+"bgc\n") ff90.write("contains\n") ff90.write("\n") ff90.write(" function create_jarmodel_"+app_name+"bgc()\n") ff90.write(" ! DESCRIPTION\n") ff90.write(" ! constructor\n") ff90.write(" implicit none\n") ff90.write(" class("+app_name+"_bgc_type), pointer :: create_jarmodel_"+app_name+"bgc\n") ff90.write(" class("+app_name+"_bgc_type), pointer :: bgc\n") ff90.write("\n") ff90.write(" allocate(bgc)\n") ff90.write(" create_jarmodel_"+app_name+"bgc => bgc\n") ff90.write("\n") ff90.write(" end function create_jarmodel_"+app_name+"bgc\n") ff90.write(" !-------------------------------------------------------------------------------\n") ff90.write(" function getvarllen_"+app_name+"(this)result(ans)\n") ff90.write("\n") ff90.write(" implicit none\n") ff90.write(" class("+app_name+"_bgc_type) , intent(inout) :: this\n") ff90.write(" integer :: ans\n") ff90.write(" ans = this%"+app_name+"_index%nstvars\n") ff90.write("\n") ff90.write(" end function getvarllen_"+app_name+"\n") ff90.write(" !-------------------------------------------------------------------------------\n") ff90.write(" subroutine getvarlist_"+app_name+"(this, nstvars, varnames, varunits, vartypes)\n") ff90.write(" implicit none\n") ff90.write(" class("+app_name+"_bgc_type) , intent(inout) :: this\n") ff90.write(" integer, intent(in) :: nstvars\n") ff90.write(" character(len=*), intent(out) :: varnames(1:nstvars)\n") ff90.write(" character(len=*), intent(out) :: varunits(1:nstvars)\n") ff90.write(" integer , intent(out) :: vartypes(1:nstvars)\n") ff90.write(" !local variables\n") ff90.write(" integer :: n\n") ff90.write("\n") ff90.write(" do n = 1, nstvars\n") ff90.write(" vartypes(n) = this%"+app_name+"_index%vartypes(n)\n") ff90.write(" write(varnames(n),'(A)')trim(this%"+app_name+"_index%varnames(n))\n") ff90.write(" write(varunits(n),'(A)')trim(this%"+app_name+"_index%varunits(n))\n") ff90.write(" enddo\n") ff90.write(" end subroutine getvarlist_"+app_name+"\n") ff90.write("\n") ff90.write(" !-------------------------------------------------------------------------------\n") ff90.write(" subroutine UpdateParas_"+app_name+"(this, biogeo_con, bstatus)\n") ff90.write(" use betr_varcon , only : betr_maxpatch_pft, betr_max_soilorder\n") ff90.write(" implicit none\n") ff90.write(" class("+app_name+"_bgc_type) , intent(inout) :: this\n") ff90.write(" class(BiogeoCon_type) , intent(in) :: biogeo_con\n") ff90.write(" type(betr_status_type) , intent(out) :: bstatus\n") ff90.write(" !local variables\n") ff90.write(" integer :: sr\n") ff90.write(" character(len=256) :: msg\n") ff90.write(" call bstatus%reset()\n") ff90.write("\n") ff90.write(" select type(biogeo_con)\n") ff90.write(" type is("+app_name+"_para_type)\n") ff90.write(" !pass in parameter values\n") ff90.write(" class default\n") ff90.write(" write(msg,'(A)')'Wrong parameter type passed in for UpdateParas in ' &\n") ff90.write(" // errMsg(mod_filename,__LINE__)\n") ff90.write(" call bstatus%set_msg(msg,err=-1)\n") ff90.write(" return\n") ff90.write(" end select\n") ff90.write(" end subroutine UpdateParas_"+app_name+"\n") ff90.write(" !-------------------------------------------------------------------------------\n") ff90.write("\n") ff90.write(" subroutine init_"+app_name+"(this, biogeo_con, batch_mode, bstatus)\n") ff90.write(" use betr_varcon , only : betr_maxpatch_pft\n") ff90.write(" implicit none\n") ff90.write(" class("+app_name+"_bgc_type) , intent(inout) :: this\n") ff90.write(" class(BiogeoCon_type) , intent(in) :: biogeo_con\n") ff90.write(" logical , intent(in) :: batch_mode\n") ff90.write(" type(betr_status_type) , intent(out) :: bstatus\n") ff90.write(" !local variables\n") ff90.write(" character(len=256) :: msg\n") ff90.write(" write(this%jarname, '(A)')'"+app_name+"'\n") ff90.write("\n") ff90.write(" this%batch_mode=batch_mode\n") ff90.write(" select type(biogeo_con)\n") ff90.write(" type is("+app_name+"_para_type)\n") ff90.write(" call bstatus%reset()\n") ff90.write(" call this%"+app_name+"_index%Init(biogeo_con%use_c13, biogeo_con%use_c14, &\n") ff90.write(" biogeo_con%non_limit, biogeo_con%nop_limit, betr_maxpatch_pft, this%batch_mode)\n") ff90.write(" call this%UpdateParas(biogeo_con, bstatus)\n") ff90.write(" if(bstatus%check_status())return\n") ff90.write("\n") ff90.write(" this%use_c13 = biogeo_con%use_c13\n") ff90.write(" this%use_c14 = biogeo_con%use_c14\n") ff90.write(" class default\n") ff90.write(" call bstatus%reset()\n") ff90.write(" write(msg,'(A)')'Wrong parameter type passed in for init_"+app_name+" in ' &\n") ff90.write(" // errMsg(mod_filename,__LINE__)\n") ff90.write(" call bstatus%set_msg(msg,err=-1)\n") ff90.write(" return\n") ff90.write(" end select\n") ff90.write("\n") ff90.write(" call this%InitAllocate(this%"+app_name+"_index)\n") ff90.write(" end subroutine init_"+app_name+"\n") ff90.write(" !-------------------------------------------------------------------------------\n") ff90.write("\n") ff90.write(" subroutine InitAllocate(this, "+app_name+"_index)\n") ff90.write("\n") ff90.write(" use betr_varcon , only : betr_maxpatch_pft, betr_max_soilorder\n") ff90.write(" implicit none\n") ff90.write(" class("+app_name+"_bgc_type) , intent(inout) :: this\n") ff90.write(" type("+app_name+"_bgc_index_type) , intent(in) :: "+app_name+"_index\n") ff90.write("\n") ff90.write(" associate( &\n") ff90.write(" nstvars => "+app_name+"_index%nstvars , &\n") ff90.write(" nprimvars=> "+app_name+"_index%nprimvars , &\n") ff90.write(" nreactions => "+app_name+"_index%nreactions &\n") ff90.write(" )\n") ff90.write("\n") ff90.write(" allocate(this%ystates0(nstvars)); this%ystates0(:) = 0._r8\n") ff90.write(" allocate(this%ystates1(nstvars)); this%ystates1(:) = 0._r8\n") ff90.write(" allocate(this%scal_f(nprimvars)); this%scal_f(:) = 0._r8\n") ff90.write(" allocate(this%conv_f(nprimvars)); this%conv_f(:) = 0._r8\n") ff90.write(" allocate(this%conc_f(nprimvars)); this%conc_f(:) = 0._r8\n") ff90.write(" allocate(this%cascade_matrix(nstvars, nreactions)); this%cascade_matrix(:,:) = 0._r8\n") ff90.write(" allocate(this%cascade_matrixd(1:nprimvars, 1:nreactions)); this%cascade_matrixd(:,:) = 0._r8\n") ff90.write(" allocate(this%cascade_matrixp(1:nprimvars, 1:nreactions)); this%cascade_matrixp(:,:) = 0._r8\n") ff90.write(" end associate\n") ff90.write(" end subroutine InitAllocate\n") ff90.write("\n") ff90.write(" !-------------------------------------------------------------------------------\n") ff90.write(" subroutine runbgc_"+app_name+"(this, is_surflit, dtime, bgc_forc, nstates, ystates0, ystatesf, bstatus)\n") ff90.write("\n") ff90.write(" !DESCRIPTION\n") ff90.write(" !do bgc model integration for one step\n") ff90.write(" use JarBgcForcType , only : JarBGC_forc_type\n") ff90.write(" use MathfuncMod , only : pd_decomp\n") ff90.write(" use BetrStatusType , only : betr_status_type\n") ff90.write(" use MathfuncMod , only : safe_div\n") ff90.write(" use tracer_varcon , only : catomw, natomw, patomw\n") ff90.write(" use MathfuncMod , only : pd_decomp\n") ff90.write(" implicit none\n") ff90.write(" class("+app_name+"_bgc_type) , intent(inout) :: this\n") ff90.write(" logical , intent(in) :: is_surflit\n") ff90.write(" real(r8) , intent(in) :: dtime\n") ff90.write(" type(JarBGC_forc_type) , intent(in) :: bgc_forc\n") ff90.write(" integer , intent(in) :: nstates\n") ff90.write(" real(r8) , intent(out) :: ystates0(nstates)\n") ff90.write(" real(r8) , intent(out) :: ystatesf(nstates)\n") ff90.write(" type(betr_status_type) , intent(out) :: bstatus\n") ff90.write("\n") ff90.write(" !local variables\n") ff90.write(" real(r8) :: time = 0._r8\n") ff90.write(" real(r8) :: yf(this%"+app_name+"_index%nstvars)\n") ff90.write(" character(len=*),parameter :: subname = 'runbgc_"+app_name+"'\n") ff90.write("\n") ff90.write(" associate( &\n") ff90.write(" ystates1 => this%ystates1 , &\n") ff90.write(" nstvars => this%"+app_name+"_index%nstvars , &\n") ff90.write(" nreactions => this%"+app_name+"_index%nreactions , &\n") ff90.write(" nprimvars => this%"+app_name+"_index%nprimvars , &\n") ff90.write(" cascade_matrix => this%cascade_matrix , &\n") ff90.write(" cascade_matrixp=> this%cascade_matrixp , &\n") ff90.write(" cascade_matrixd=> this%cascade_matrixd &\n") ff90.write(" )\n") ff90.write("\n") ff90.write(" call bstatus%reset()\n") ff90.write(" !initialize state variables\n") ff90.write(" call this%init_states(this%"+app_name+"_index, bgc_forc)\n") ff90.write("\n") ff90.write(" ystates0(:) = this%ystates0(:)\n") ff90.write(" call this%add_ext_input(dtime, this%"+app_name+"_index, bgc_forc)\n") ff90.write(" call this%arenchyma_gas_transport(this%"+app_name+"_index, dtime)\n") ff90.write(" call this%calc_cascade_matrix(this%"+app_name+"_index, cascade_matrix)\n") ff90.write(" call pd_decomp(nprimvars, nreactions, cascade_matrix(1:nprimvars, 1:nreactions), &\n") ff90.write(" cascade_matrixp, cascade_matrixd, bstatus)\n") ff90.write(" if(bstatus%check_status())return\n") ff90.write("\n") ff90.write(" time = 0._r8\n") ff90.write(" yf(:) = ystates1(:)\n") ff90.write(" call this%ode_adapt_ebbks1(yf, nprimvars, nstvars, time, dtime, ystates1)\n") ff90.write("\n") ff90.write(" ystatesf(:) = ystates1(:)\n") ff90.write("\n") ff90.write(" end associate\n") ff90.write(" end subroutine runbgc_"+app_name+"\n") ff90.write(" !-------------------------------------------------------------------------------\n") ff90.write(" subroutine "+app_name+"_rrates(this, "+app_name+"_index, dtime, nstates, ystates1, doc_cue, rrates)\n") ff90.write(" !\n") ff90.write(" !DESCRIPTION\n") ff90.write(" !calculate reaction rates, this subroutine should be customized\n") ff90.write(" implicit none\n") ff90.write(" class("+app_name+"_bgc_type) , intent(inout) :: this\n") ff90.write(" real(r8) , intent(in) :: dtime\n") ff90.write(" integer , intent(in) :: nstates\n") ff90.write(" real(r8) , intent(in) :: ystates1(nstates)\n") ff90.write(" type("+app_name+"_bgc_index_type) , intent(in) :: "+app_name+"_index\n") ff90.write(" real(r8) , intent(in) :: doc_cue\n") ff90.write(" real(r8) , intent(out) :: rrates("+app_name+"_index%nreactions)\n") ff90.write(" !local variables\n") ff90.write(" integer :: jj\n") ff90.write(" associate( &\n") ff90.write(" lit1 => "+app_name+"_index%lit1 , &\n") ff90.write(" lit2 => "+app_name+"_index%lit2 , &\n") ff90.write(" lit3 => "+app_name+"_index%lit3 , &\n") ff90.write(" cwd => "+app_name+"_index%cwd , &\n") ff90.write(" lid_dom => "+app_name+"_index%lid_dom , &\n") ff90.write(" lid_o2 => "+app_name+"_index%lid_o2 , &\n") ff90.write(" lid_co2 => "+app_name+"_index%lid_co2 , &\n") ff90.write(" lit1_depoly_reac => "+app_name+"_index%lit1_depoly_reac , &\n") ff90.write(" lit2_depoly_reac => "+app_name+"_index%lit2_depoly_reac , &\n") ff90.write(" lit3_depoly_reac => "+app_name+"_index%lit3_depoly_reac , &\n") ff90.write(" cwd_depoly_reac => "+app_name+"_index%cwd_depoly_reac &\n") ff90.write(" )\n") ff90.write("\n") ff90.write(" !assemble the derivatives\n") ff90.write(" rrates(:) = 0._r8\n") ff90.write(" end associate\n") ff90.write(" end subroutine "+app_name+"_rrates\n") ff90.write(" !-------------------------------------------------------------------------------\n") ff90.write(" subroutine init_states(this, "+app_name+"_index, bgc_forc)\n") ff90.write("\n") ff90.write(" use "+app_name+"BGCIndexType , only : "+app_name+"_bgc_index_type\n") ff90.write(" use JarBgcForcType , only : JarBGC_forc_type\n") ff90.write(" implicit none\n") ff90.write(" class("+app_name+"_bgc_type) , intent(inout) :: this\n") ff90.write(" type("+app_name+"_bgc_index_type) , intent(in) :: "+app_name+"_index\n") ff90.write(" type(JarBGC_forc_type) , intent(in) :: bgc_forc\n") ff90.write("\n") ff90.write(" associate( &\n") ff90.write(" lid_co2_hr => "+app_name+"_index%lid_co2_hr, &\n") ff90.write(" lid_n2 => "+app_name+"_index%lid_n2, &\n") ff90.write(" lid_o2 => "+app_name+"_index%lid_o2, &\n") ff90.write(" lid_co2 => "+app_name+"_index%lid_co2, &\n") ff90.write(" lid_c13_co2 => "+app_name+"_index%lid_c13_co2, &\n") ff90.write(" lid_c14_co2 => "+app_name+"_index%lid_c14_co2, &\n") ff90.write(" lid_ar => "+app_name+"_index%lid_ar, &\n") ff90.write(" lid_o2_paere => "+app_name+"_index%lid_o2_paere, &\n") ff90.write(" lid_n2_paere => "+app_name+"_index%lid_n2_paere, &\n") ff90.write(" lid_ar_paere => "+app_name+"_index%lid_ar_paere, &\n") ff90.write(" lid_co2_paere => "+app_name+"_index%lid_co2_paere, &\n") ff90.write(" lid_ch4_paere => "+app_name+"_index%lid_ch4_paere, &\n") ff90.write(" lid_c13_co2_paere => "+app_name+"_index%lid_c13_co2_paere, &\n") ff90.write(" lid_c14_co2_paere => "+app_name+"_index%lid_c14_co2_paere, &\n") ff90.write(" lid_ch4 => "+app_name+"_index%lid_ch4 &\n") ff90.write(" )\n") ff90.write("\n") ff90.write(" this%ystates0(:) = bgc_forc%ystates(:)\n") ff90.write(" this%ystates0(lid_co2_hr) = 0._r8\n") ff90.write(" this%ystates1(:) = this%ystates0(:)\n") ff90.write("\n") ff90.write(" !set conversion parameters for arenchyma transport\n") ff90.write(" this%scal_f(lid_n2) = bgc_forc%aren_cond_n2\n") ff90.write(" this%conc_f(lid_n2) = bgc_forc%conc_atm_n2\n") ff90.write(" this%conv_f(lid_n2) = 1._r8/bgc_forc%n2_g2b\n") ff90.write(" this%scal_f(lid_o2) = bgc_forc%aren_cond_o2\n") ff90.write(" this%conc_f(lid_o2) = bgc_forc%conc_atm_o2\n") ff90.write(" this%conv_f(lid_o2) = 1._r8/bgc_forc%o2_g2b\n") ff90.write(" this%scal_f(lid_ar) = bgc_forc%aren_cond_ar\n") ff90.write(" this%conc_f(lid_ar) = bgc_forc%conc_atm_ar\n") ff90.write(" this%conv_f(lid_ar) = 1._r8/bgc_forc%ar_g2b\n") ff90.write(" this%scal_f(lid_co2) = bgc_forc%aren_cond_co2\n") ff90.write(" this%conc_f(lid_co2) = bgc_forc%conc_atm_co2\n") ff90.write(" this%conv_f(lid_co2) = 1._r8/bgc_forc%co2_g2b\n") ff90.write(" if(this%use_c13)then\n") ff90.write(" this%scal_f(lid_c13_co2) = bgc_forc%aren_cond_co2_c13\n") ff90.write(" this%conc_f(lid_c13_co2) = bgc_forc%conc_atm_co2_c13\n") ff90.write(" this%conv_f(lid_c13_co2) = 1._r8/bgc_forc%co2_g2b\n") ff90.write(" endif\n") ff90.write(" if(this%use_c14)then\n") ff90.write(" this%scal_f(lid_c14_co2) = bgc_forc%aren_cond_co2_c14\n") ff90.write(" this%conc_f(lid_c14_co2) = bgc_forc%conc_atm_co2_c14\n") ff90.write(" endif\n") ff90.write(" this%scal_f(lid_ch4) = bgc_forc%aren_cond_ch4\n") ff90.write(" this%conc_f(lid_ch4) = bgc_forc%conc_atm_ch4\n") ff90.write(" this%conv_f(lid_ch4) = 1._r8/bgc_forc%ch4_g2b\n") ff90.write(" end associate\n") ff90.write(" end subroutine init_states\n") ff90.write(" !--------------------------------------------------------------------\n") ff90.write(" subroutine add_ext_input(this, dtime, "+app_name+"_index, bgc_forc)\n") ff90.write(" !\n") ff90.write(" !DESCRIPTION\n") ff90.write(" use "+app_name+"BGCIndexType , only : "+app_name+"_bgc_index_type\n") ff90.write(" use JarBgcForcType , only : JarBGC_forc_type\n") ff90.write(" use tracer_varcon , only : catomw, natomw, patomw,c13atomw,c14atomw\n") ff90.write(" use MathfuncMod , only : safe_div\n") ff90.write(" implicit none\n") ff90.write(" class("+app_name+"_bgc_type) , intent(inout) :: this\n") ff90.write(" real(r8), intent(in) :: dtime\n") ff90.write(" type("+app_name+"_bgc_index_type) , intent(in) :: "+app_name+"_index\n") ff90.write(" type(JarBGC_forc_type) , intent(in) :: bgc_forc\n") ff90.write("\n") ff90.write(" associate( &\n") ff90.write(" lit1 => "+app_name+"_index%lit1, &\n") ff90.write(" lit2 => "+app_name+"_index%lit2, &\n") ff90.write(" lit3 => "+app_name+"_index%lit3, &\n") ff90.write(" cwd => "+app_name+"_index%cwd &\n") ff90.write(" )\n") ff90.write("\n") ff90.write(" this%ystates1(lit1)=this%ystates0(lit1) + dtime * bgc_forc%cflx_input_litr_met\n") ff90.write(" this%ystates1(lit2)=this%ystates0(lit2) + dtime * bgc_forc%cflx_input_litr_cel\n") ff90.write(" this%ystates1(lit3)=this%ystates0(lit3) + dtime * bgc_forc%cflx_input_litr_lig\n") ff90.write(" this%ystates1(cwd)=this%ystates0(cwd) + dtime * bgc_forc%cflx_input_litr_cwd\n") ff90.write("\n") ff90.write(" end associate\n") ff90.write(" end subroutine add_ext_input\n") ff90.write("\n") ff90.write(" !--------------------------------------------------------------------\n") ff90.write(" subroutine arenchyma_gas_transport(this, "+app_name+"_index, dtime)\n") ff90.write(" use "+app_name+"BGCIndexType , only : "+app_name+"_bgc_index_type\n") ff90.write(" implicit none\n") ff90.write(" class("+app_name+"_bgc_type) , intent(inout) :: this\n") ff90.write(" type("+app_name+"_bgc_index_type) , intent(in) :: "+app_name+"_index\n") ff90.write(" real(r8), intent(in) :: dtime\n") ff90.write("\n") ff90.write(" !local variables\n") ff90.write(" integer :: j\n") ff90.write(" real(r8) :: y0\n") ff90.write(" associate( &\n") ff90.write(" lid_n2 => "+app_name+"_index%lid_n2 , &\n") ff90.write(" lid_o2 => "+app_name+"_index%lid_o2 , &\n") ff90.write(" lid_co2 => "+app_name+"_index%lid_co2 , &\n") ff90.write(" lid_c13_co2 => "+app_name+"_index%lid_c13_co2 , &\n") ff90.write(" lid_c14_co2 => "+app_name+"_index%lid_c14_co2 , &\n") ff90.write(" lid_ar => "+app_name+"_index%lid_ar , &\n") ff90.write(" lid_o2_paere => "+app_name+"_index%lid_o2_paere , &\n") ff90.write(" lid_n2_paere => "+app_name+"_index%lid_n2_paere , &\n") ff90.write(" lid_ar_paere => "+app_name+"_index%lid_ar_paere , &\n") ff90.write(" lid_co2_paere => "+app_name+"_index%lid_co2_paere , &\n") ff90.write(" lid_ch4_paere => "+app_name+"_index%lid_ch4_paere , &\n") ff90.write(" lid_c13_co2_paere => "+app_name+"_index%lid_c13_co2_paere, &\n") ff90.write(" lid_c14_co2_paere => "+app_name+"_index%lid_c14_co2_paere, &\n") ff90.write(" lid_ch4 => "+app_name+"_index%lid_ch4 &\n") ff90.write(" )\n") ff90.write("\n") ff90.write(" j = lid_o2; y0=this%ystates1(j)\n") ff90.write(" call exp_ode_int(dtime, this%scal_f(j), this%conv_f(j), this%conc_f(j), this%ystates1(j))\n") ff90.write(" this%ystates1("+app_name+"_index%lid_o2_paere) = this%ystates1(j)-y0\n") ff90.write("\n") ff90.write(" if( spinup_state == 0)then\n") ff90.write(" j = lid_n2; y0=this%ystates1(j)\n") ff90.write(" call exp_ode_int(dtime, this%scal_f(j), this%conv_f(j), this%conc_f(j), this%ystates1(j))\n") ff90.write("\n") ff90.write(" this%ystates1("+app_name+"_index%lid_n2_paere) = this%ystates1(j)-y0\n") ff90.write(" j = lid_ar; y0=this%ystates1(j)\n") ff90.write(" call exp_ode_int(dtime, this%scal_f(j), this%conv_f(j), this%conc_f(j), this%ystates1(j))\n") ff90.write(" this%ystates1("+app_name+"_index%lid_ar_paere) = this%ystates1(j)-y0\n") ff90.write("\n") ff90.write(" j = lid_ch4; y0=this%ystates1(j)\n") ff90.write(" call exp_ode_int(dtime, this%scal_f(j), this%conv_f(j), this%conc_f(j), this%ystates1(j))\n") ff90.write(" this%ystates1("+app_name+"_index%lid_ch4_paere) = this%ystates1(j)-y0\n") ff90.write("\n") ff90.write(" j = lid_co2; y0=this%ystates1(j)\n") ff90.write(" call exp_ode_int(dtime, this%scal_f(j), this%conv_f(j), this%conc_f(j), this%ystates1(j))\n") ff90.write(" this%ystates1("+app_name+"_index%lid_co2_paere) = this%ystates1(j)-y0\n") ff90.write("\n") ff90.write(" if(this%use_c13)then\n") ff90.write(" j = lid_c13_co2; y0=this%ystates1(j)\n") ff90.write(" call exp_ode_int(dtime, this%scal_f(j), this%conv_f(j), this%conc_f(j), this%ystates1(j))\n") ff90.write(" this%ystates1("+app_name+"_index%lid_c13_co2_paere) = this%ystates1(j)-y0\n") ff90.write(" endif\n") ff90.write("\n") ff90.write(" if(this%use_c14)then\n") ff90.write(" j = lid_c14_co2; y0=this%ystates1(j)\n") ff90.write(" call exp_ode_int(dtime, this%scal_f(j), this%conv_f(j), this%conc_f(j), this%ystates1(j))\n") ff90.write(" this%ystates1("+app_name+"_index%lid_c14_co2_paere) = this%ystates1(j)-y0\n") ff90.write(" endif\n") ff90.write(" endif\n") ff90.write(" end associate\n") ff90.write(" contains\n") ff90.write(" subroutine exp_ode_int(dt, c1, c2, c3, y0)\n") ff90.write(" !\n") ff90.write(" ! DESCRIPTION\n") ff90.write(" ! solve dy/dt=-c1*(c2*y-c3) using analytic solution\n") ff90.write(" implicit none\n") ff90.write(" real(r8), intent(in) :: dt\n") ff90.write(" real(r8), intent(in) :: c1\n") ff90.write(" real(r8), intent(in) :: c2\n") ff90.write(" real(r8), intent(in) :: c3\n") ff90.write(" real(r8), intent(inout) :: y0\n") ff90.write("\n") ff90.write(" if(c1>0._r8)then\n") ff90.write(" y0 = c3/c2+(y0-c3/c2)*exp(-c1/c2*dtime)\n") ff90.write(" endif\n") ff90.write(" end subroutine exp_ode_int\n") ff90.write(" end subroutine arenchyma_gas_transport\n") ff90.write(" !--------------------------------------------------------------------\n") ff90.write(" subroutine calc_cascade_matrix(this, "+app_name+"_index, cascade_matrix)\n") ff90.write(" !\n") ff90.write(" !DESCRPTION\n") ff90.write(" !compute the cascade matrix\n") ff90.write(" implicit none\n") ff90.write(" class("+app_name+"_bgc_type) , intent(inout) :: this\n") ff90.write(" type("+app_name+"_bgc_index_type) , intent(in) :: "+app_name+"_index\n") ff90.write(" real(r8) , intent(inout) :: cascade_matrix("+app_name+"_index%nstvars, "+app_name+"_index%nreactions)\n") ff90.write(" !local variables\n") ff90.write(" integer :: reac\n") ff90.write("\n") ff90.write(" associate( &\n") ff90.write(" lit1 => "+app_name+"_index%lit1 , &\n") ff90.write(" lit2 => "+app_name+"_index%lit2 , &\n") ff90.write(" lit3 => "+app_name+"_index%lit3 , &\n") ff90.write(" cwd => "+app_name+"_index%cwd , &\n") ff90.write(" lid_dom => "+app_name+"_index%lid_dom , &\n") ff90.write(" lid_micbl => "+app_name+"_index%lid_micbl , &\n") ff90.write(" lid_micbd => "+app_name+"_index%lid_micbd , &\n") ff90.write(" lid_cue => "+app_name+"_index%lid_cue , &\n") ff90.write(" lid_o2 => "+app_name+"_index%lid_o2 , &\n") ff90.write(" lid_co2 => "+app_name+"_index%lid_co2 , &\n") ff90.write(" lid_co2_hr => "+app_name+"_index%lid_co2_hr &\n") ff90.write(" ! cue_met => this%cue_met , &\n") ff90.write(" ! cue_cel => this%cue_cel , &\n") ff90.write(" ! cue_lig => this%cue_lig , &\n") ff90.write(" ! cue_cwd => this%cue_cwd &\n") ff90.write(" ! f_mic2d => this%f_mic2d , &\n") ff90.write(" ! f_mic2c => this%f_mic2c &\n") ff90.write(" )\n") ff90.write("\n") ff90.write(" reac = "+app_name+"_index%lit1_depoly_reac\n") ff90.write(" cascade_matrix(lit1, reac) = -1._r8\n") ff90.write(" cascade_matrix(lid_dom,reac)=1._r8\n") ff90.write(" ! cascade_matrix(lid_cue,reac)=cue_met\n") ff90.write("\n") ff90.write(" reac = "+app_name+"_index%lit2_depoly_reac\n") ff90.write(" cascade_matrix(lit2, reac) = -1._r8\n") ff90.write(" cascade_matrix(lid_dom,reac)= 1._r8\n") ff90.write(" ! cascade_matrix(lid_cue,reac)= cue_cel\n") ff90.write("\n") ff90.write(" reac = "+app_name+"_index%lit3_depoly_reac\n") ff90.write(" cascade_matrix(lit3, reac) = -1._r8\n") ff90.write(" cascade_matrix(lid_dom,reac)=1._r8\n") ff90.write(" ! cascade_matrix(lid_cue,reac)=cue_lig\n") ff90.write("\n") ff90.write(" ! reac = "+app_name+"_index%cwd_depoly_reac\n") ff90.write(" ! cascade_matrix(cwd, reac) = -1._r8\n") ff90.write(" ! cascade_matrix(lid_dom,reac)=1._r8\n") ff90.write(" ! cascade_matrix(lid_cue,reac)=cue_cwd\n") ff90.write("\n") ff90.write(" ! reac = "+app_name+"_index%micbd_depoly_reac\n") ff90.write(" ! cascade_matrix(lid_micbd, reac) = -1._r8\n") ff90.write(" ! cascade_matrix(lid_dom,reac) = 1._r8\n") ff90.write(" ! cascade_matrix(lid_cue,reac) = 0.5_r8\n") ff90.write("\n") ff90.write(" ! reac = "+app_name+"_index%micbl_mort_reac\n") ff90.write(" ! cascade_matrix(lid_micbl, reac) = -1._r8\n") ff90.write(" ! cascade_matrix(lid_micbd,reac) = f_mic2D\n") ff90.write(" ! cascade_matrix(lid_dom,reac) = f_mic2C\n") ff90.write("\n") ff90.write(" reac = "+app_name+"_index%o2_resp_reac\n") ff90.write(" cascade_matrix(lid_o2, reac) = -1._r8\n") ff90.write(" cascade_matrix(lid_co2_hr,reac) = 1._r8\n") ff90.write(" cascade_matrix(lid_co2,reac) = 1._r8\n") ff90.write("\n") ff90.write(" ! reac = "+app_name+"_index%doc_uptake_reac\n") ff90.write(" ! cascade_matrix(lid_doc, reac) = -1._r8\n") ff90.write(" ! cascade_matrix(lid_micbl, reac) = 1._r8\n") ff90.write(" end associate\n") ff90.write(" end subroutine calc_cascade_matrix\n") ff90.write("\n") ff90.write(" !-------------------------------------------------------------------------------\n") ff90.write(" subroutine ode_adapt_ebbks1(me, y0, nprimeq, neq, t, dt, y)\n") ff90.write(" !\n") ff90.write(" !DESCRIPTION:\n") ff90.write(" !first order implicit bkks ode integration with the adaptive time stepping\n") ff90.write(" !This could be used as an example for the implementation of time-adaptive\n") ff90.write(" !mbbks1.\n") ff90.write(" ! !NOTE:\n") ff90.write(" ! this code should only be used for mass positive ODE integration\n") ff90.write(" use ODEMOD, only : ebbks, get_rerr, get_tscal\n") ff90.write(" implicit none\n") ff90.write(" ! !ARGUMENTS:\n") ff90.write(" class("+app_name+"_bgc_type) , intent(inout) :: me\n") ff90.write(" integer, intent(in) :: neq ! number of equations\n") ff90.write(" real(r8), intent(in) :: y0(neq) ! state variable at previous time step\n") ff90.write(" real(r8), intent(in) :: t ! time stamp\n") ff90.write(" real(r8), intent(in) :: dt ! time stepping\n") ff90.write(" integer, intent(in) :: nprimeq ! number of primary variables subject to positivity constraint\n") ff90.write(" real(r8), intent(out) :: y(neq) ! updated state variable\n") ff90.write("\n") ff90.write(" ! !LOCAL VARIABLES:\n") ff90.write(" real(r8) :: yc(neq) !coarse time stepping solution\n") ff90.write(" real(r8) :: yf(neq) !fine time stepping solution\n") ff90.write(" real(r8) :: ycp(neq) !temporary variable\n") ff90.write(" real(r8) :: f(neq) ! derivative\n") ff90.write(" real(r8) :: dt2\n") ff90.write(" real(r8) :: dtr\n") ff90.write(" real(r8) :: dt05\n") ff90.write(" real(r8) :: dtmin\n") ff90.write(" real(r8) :: tt,tt2 !temporary variables\n") ff90.write(" logical :: acc\n") ff90.write(" real(r8) :: rerr, dt_scal, pscal\n") ff90.write(" integer :: n, nJ\n") ff90.write(" real(r8), parameter :: maxtdiv=64._r8\n") ff90.write("\n") ff90.write(" dt2=dt\n") ff90.write(" dtmin=dt/maxtdiv\n") ff90.write(" dtr=dt\n") ff90.write(" tt=0._r8\n") ff90.write(" !make a copy of the solution at the current time step\n") ff90.write(" y(:)=y0(:)\n") ff90.write(" do\n") ff90.write(" if(dt2<=dtmin)then\n") ff90.write(" call me%bgc_integrate(y, dt2, tt, nprimeq, neq, f)\n") ff90.write(" call ebbks(y, f, nprimeq, neq, dt2, yc, pscal)\n") ff90.write(" dtr=dtr-dt2\n") ff90.write(" tt=tt+dt2\n") ff90.write(" y=yc\n") ff90.write(" else\n") ff90.write(" !get coarse grid solution\n") ff90.write(" call me%bgc_integrate(y, dt2, tt, nprimeq, neq, f)\n") ff90.write(" call ebbks(y, f, nprimeq, neq, dt2, yc, pscal)\n") ff90.write(" !get fine grid solution\n") ff90.write(" dt05=dt2*0.5_r8\n") ff90.write(" call ebbks(y,f,nprimeq, neq,dt05, yf, pscal)\n") ff90.write(" tt2=tt+dt05\n") ff90.write(" ycp=yf\n") ff90.write(" call me%bgc_integrate(ycp, dt05, tt, nprimeq, neq, f)\n") ff90.write(" call ebbks(ycp,f,nprimeq, neq,dt05,yf,pscal)\n") ff90.write(" !determine the relative error\n") ff90.write(" rerr=get_rerr(yc,yf, neq)*exp(1._r8-1._r8/(pscal+1.e-20))\n") ff90.write(" !determine time scalar factor\n") ff90.write(" call get_tscal(rerr,dt_scal,acc)\n") ff90.write(" if(acc)then\n") ff90.write(" dtr=dtr-dt2\n") ff90.write(" tt=tt+dt2\n") ff90.write(" y=yf\n") ff90.write(" endif\n") ff90.write(" dt2=dt2*dt_scal\n") ff90.write(" dt2=min(dt2,dtr)\n") ff90.write(" endif\n") ff90.write(" if(abs(dtr/dt)<1.e-4_r8)exit\n") ff90.write(" enddo\n") ff90.write(" end subroutine ode_adapt_ebbks1\n") ff90.write("\n") ff90.write(" !--------------------------------------------------------------------\n") ff90.write(" subroutine bgc_integrate(this, ystate, dtime, time, nprimvars, nstvars, dydt)\n") ff90.write(" !\n") ff90.write(" !DESCRPTION\n") ff90.write(" !core code for integrating the bgc system\n") ff90.write(" use SOMStateVarUpdateMod , only : calc_dtrend_som_bgc\n") ff90.write(" use MathfuncMod , only : lom_type, safe_div\n") ff90.write(" implicit none\n") ff90.write(" class("+app_name+"_bgc_type) , intent(inout) :: this\n") ff90.write(" integer , intent(in) :: nstvars\n") ff90.write(" integer , intent(in) :: nprimvars\n") ff90.write(" real(r8) , intent(in) :: dtime\n") ff90.write(" real(r8) , intent(in) :: time\n") ff90.write(" real(r8) , intent(in) :: ystate(nstvars)\n") ff90.write(" real(r8) , intent(out) :: dydt(nstvars)\n") ff90.write(" !local variables\n") ff90.write(" integer :: jj, it\n") ff90.write(" integer, parameter :: itmax = 10\n") ff90.write(" type(lom_type) :: lom\n") ff90.write(" type(betr_status_type) :: bstatus\n") ff90.write(" logical :: lneg\n") ff90.write(" real(r8) :: rscal(1:this%"+app_name+"_index%nreactions)\n") ff90.write(" real(r8) :: rrates(1:nstvars)\n") ff90.write(" real(r8) :: p_dt(1:nprimvars)\n") ff90.write(" real(r8) :: d_dt(1:nprimvars)\n") ff90.write(" real(r8) :: pscal(1:nprimvars)\n") ff90.write(" !real(r8) :: doc_cue\n") ff90.write("\n") ff90.write(" associate( &\n") ff90.write(" !lid_cue => this%"+app_name+"_index%lid_cue , &\n") ff90.write(" lid_dom => this%"+app_name+"_index%lid_dom , &\n") ff90.write(" doc_uptake_reac=> this%"+app_name+"_index%doc_uptake_reac, &\n") ff90.write(" nreactions => this%"+app_name+"_index%nreactions &\n") ff90.write(" )\n") ff90.write("\n") ff90.write(" !customize the following lines\n") ff90.write(" !doc_cue = safe_div(ystate(lid_cue), ystate(lid_doc))\n") ff90.write(" !call this%"+app_name+"_rrates(this%"+app_name+"_index, dtime, nstvars, ystate, doc_cue, rrates)\n") ff90.write(" !this%cascade_matrixd(lid_cue, doc_uptake_reac) = doc_cue\n") ff90.write(" !this%cascade_matrix(lid_cue, doc_uptake_reac) = -doc_cue\n") ff90.write("\n") ff90.write(" it=0\n") ff90.write(" rscal=0._r8\n") ff90.write(" do\n") ff90.write(" call calc_dtrend_som_bgc(nprimvars, nreactions, this%cascade_matrixp(1:nprimvars, 1:nreactions), rrates, p_dt)\n") ff90.write(" call calc_dtrend_som_bgc(nprimvars, nreactions, this%cascade_matrixd(1:nprimvars, 1:nreactions), rrates, d_dt)\n") ff90.write(" !update the state variables\n") ff90.write(" call lom%calc_state_pscal(nprimvars, dtime, ystate(1:nprimvars), p_dt(1:nprimvars), d_dt(1:nprimvars), &\n") ff90.write(" pscal(1:nprimvars), lneg, bstatus)\n") ff90.write(" if(lneg .and. it<=itmax)then\n") ff90.write(" call lom%calc_reaction_rscal(nprimvars, nreactions, pscal(1:nprimvars), &\n") ff90.write(" this%cascade_matrixd(1:nprimvars, 1:nreactions),rscal, bstatus)\n") ff90.write(" call lom%apply_reaction_rscal(nreactions, rscal(1:nreactions), rrates(1:nreactions))\n") ff90.write(" else\n") ff90.write(" call calc_dtrend_som_bgc(nstvars, nreactions, this%cascade_matrix(1:nstvars, 1:nreactions), &\n") ff90.write(" rrates(1:nreactions), dydt)\n") ff90.write(" exit\n") ff90.write(" endif\n") ff90.write(" it = it + 1\n") ff90.write(" enddo\n") ff90.write(" end associate\n") ff90.write(" end subroutine bgc_integrate\n") ff90.write(" !-------------------------------------------------------------------------------\n") ff90.write(" subroutine init_cold_"+app_name+"(this, nstvars, ystates)\n") ff90.write(" !\n") ff90.write(" !DESCRPTION\n") ff90.write(" !do a cold state initialization for batch mode simulation\n") ff90.write(" implicit none\n") ff90.write(" class("+app_name+"_bgc_type) , intent(inout) :: this\n") ff90.write(" integer , intent(in) :: nstvars\n") ff90.write(" real(r8) , intent(inout) :: ystates(nstvars)\n") ff90.write("\n") ff90.write(" !Initialize necessary state variables below\n") ff90.write(" end subroutine init_cold_"+app_name+"\n") ff90.write(" end module "+app_name+"BGCType\n") ff90.close()