diff --git a/lilac/.gitignore b/lilac/.gitignore index 21537a4ee9..6e5803401e 100644 --- a/lilac/.gitignore +++ b/lilac/.gitignore @@ -14,3 +14,4 @@ components/ *.pyc build/ +_build/ diff --git a/lilac/CMakeLists.txt b/lilac/CMakeLists.txt index 4268ea956d..89ae531242 100644 --- a/lilac/CMakeLists.txt +++ b/lilac/CMakeLists.txt @@ -1,15 +1,172 @@ cmake_minimum_required(VERSION 2.8.12.1) -project(LILAC Fortran) -enable_language(Fortran) +##include("/glade/work/negins/UFSCOMP/cime/tools/Macros.cmake") + +set (CIME_ROOT "/glade/work/negins/UFSCOMP/cime") +message ("CIME_ROOT: ${CIME_ROOT}") set(CMAKE_MODULE_PATH "${CMAKE_SOURCE_DIR}/cmake/CMakeModules") +message ("CMAKE_MODULE_PATH: ${CMAKE_MODULE_PATH}") + + +set (CIME_CMAKE_MODULE_DIRECTORY "/glade/work/negins/UFSCOMP/cime/src/CMake/") +message ("CIME_CMAKE_MODULE_DIRECTORY: ${CIME_CMAKE_MODULE_DIRECTORY}") + + +list(APPEND CMAKE_MODULE_PATH ${CIME_CMAKE_MODULE_DIRECTORY}) +message ("CMAKE_MODULE_PATH: ${CMAKE_MODULE_PATH}") + +set (MACRO_ROOT "/glade/work/negins/UFSCOMP/cime/tools/") +include(${MACRO_ROOT}/Macros.cmake) + +list(APPEND CMAKE_MODULE_PATH ${MACRO_ROOT}) +message ("CMAKE_MODULE_PATH: ${CMAKE_MODULE_PATH}") + + +set (CLM_ROOT "/glade/work/negins/UFSCOMP/components/clm") + +message("~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~") + +include_directories (${CMAKE_SOURCE_DIR}/cmake/CMakeModules/) +include (${CMAKE_SOURCE_DIR}/cmake/CMakeModules/genf90_utils.cmake) +include (${CMAKE_SOURCE_DIR}/cmake/CMakeModules/Sourcelist_utils.cmake) +include (${CMAKE_SOURCE_DIR}/cmake/CMakeModules/pFUnit_utils.cmake) +include (${CMAKE_SOURCE_DIR}/cmake/CMakeModules/FindpFUnit.cmake) + + +#include (Macros.cmake) +#include(CIME_initial_setup) + +message("~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~") + +### ------------------------------------------------------------- + +# project name +project(LILAC Fortran C) +enable_language(Fortran) + + +# This definition is needed to avoid having ESMF depend on mpi +add_definitions(-DHIDE_MPI) + + +message("----------------------------------------------------") +message ("CMAKE_CURRENT_SOURCE_DIR: ${CMAKE_CURRENT_SOURCE_DIR}") +message ("CMAKE_MODULE_PATH: ${CMAKE_MODULE_PATH}") +message("----------------------------------------------------") + + + +message("----------------------------------------------------") +# Add source directories from other share code (csm_share, etc.). This should be +# done first, so that in case of name collisions, the CLM versions take +# precedence (when there are two files with the same name, the one added later +# wins). +add_subdirectory(${CIME_ROOT}/src/share/util csm_share) +add_subdirectory(${CIME_ROOT}/src/share/unit_test_stubs/util csm_share_stubs) +add_subdirectory(${CIME_ROOT}/src/share/esmf_wrf_timemgr esmf_wrf_timemgr) +add_subdirectory(${CIME_ROOT}/src/drivers/mct/shr drv_share) +message("----------------------------------------------------") + +# Extract just the files we need from drv_share +set (drv_sources_needed_base + glc_elevclass_mod.F90 + ) +extract_sources("${drv_sources_needed_base}" "${drv_sources}" drv_sources_needed) + +message("~~~~~~~~~~~~~~~~~~~~~~CLM_ROOT~~~~~~~~~~~~~~~~~~~~~~") +# Add CLM source directories (these add their own test directories) +add_subdirectory(${CLM_ROOT}/src/utils clm_utils) +add_subdirectory(${CLM_ROOT}/src/biogeochem clm_biogeochem) +add_subdirectory(${CLM_ROOT}/src/soilbiogeochem clm_soilbiogeochem) +add_subdirectory(${CLM_ROOT}/src/biogeophys clm_biogeophys) +add_subdirectory(${CLM_ROOT}/src/dyn_subgrid clm_dyn_subgrid) +add_subdirectory(${CLM_ROOT}/src/main clm_main) +add_subdirectory(${CLM_ROOT}/src/init_interp clm_init_interp) +add_subdirectory(${CLM_ROOT}/src/fates/main fates_main) + +# Add general unit test directories (stubbed out files, etc.) +add_subdirectory(unit_test_stubs) +add_subdirectory(unit_test_shr) + + +# Remove shr_mpi_mod from share_sources. +# This is needed because we want to use the mock shr_mpi_mod in place of the real one +# +# TODO: this should be moved into a general-purpose function in Sourcelist_utils. +# Then this block of code could be replaced with a single call, like: +# remove_source_file(${share_sources} "shr_mpi_mod.F90")} + +foreach (sourcefile ${share_sources}) + string(REGEX MATCH "shr_mpi_mod.F90" match_found ${sourcefile}) + if(match_found) + list(REMOVE_ITEM share_sources ${sourcefile}) + endif() +endforeach() + + +# We rely on pio for cmake utilities like findnetcdf.cmake, so that we don't +# need to duplicate this cmake code +message ("CMAKE_MODULE_PATH: ${CMAKE_MODULE_PATH}") +list (APPEND CMAKE_MODULE_PATH "${CIME_ROOT}/src/externals/pio2/cmake") +message ("CMAKE_MODULE_PATH: ${CMAKE_MODULE_PATH}") + + +add_subdirectory (${CIME_ROOT}/src/externals/pio2/test) + +message("----------------------------------------------------") +option(ENABLE_PFUNIT "Enable pfUnit testing Framework" ON) +if (ENABLE_PFUNIT) + find_package(pfUnit) + include(pfUnit_utils) + include_directories("${PFUNIT_INCLUDE_DIRS}") +endif (ENABLE_PFUNIT) +message("----------------------------------------------------") + find_package(MPI REQUIRED) # TODO: This should be found from the find_package call but its not working -set(CMAKE_Fortran_COMPILER "/usr/lib64/mpich/bin/mpif90") +#set(CMAKE_Fortran_COMPILER "/usr/lib64/mpich/bin/mpif90") find_package(ESMF REQUIRED) + +message("------------include (CIME_utils)--------------------") +include(CIME_utils) +message("----------------------------------------------------") + +find_package(NetCDF COMPONENTS C Fortran) +include_directories(${NetCDF_C_INCLUDE_DIRS} ${NetCDF_Fortran_INCLUDE_DIRS}) +message("NetCDF_C_INCLUDE_DIRS: ${NetCDF_C_INCLUDE_DIRS}") +message("----------------------------------------------------") + +##=======## +#set(CESM_ROOT "/glade/work/negins/UFSCOMP/") +#set(CSM_SHR "/glade/work/negins/UFSCOMP/components/clm/src/unit_test_stubs/csm_share/") + +#add_subdirectory(${CESM_ROOT}/models/csm_share/shr csm_share) +#add_subdirectory(${CSM_SHR} ) + +message("----------------------------------------------------") + + + +# -lclm libclm.a +SET(NAMES libclm.a) + +#find_library(LIB_TO_INCLUDE +# libclm.a +# PATHS /glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/lib/) +#find_library(LIB_TO_INCLUDE /glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/lib/) + +#message(STATUS "include_directories for ${NAMES}: ${LIB_TO_INCLUDE}") +#include_directories(${LIB_TO_INCLUDE}) +#link_directories(${LIB_TO_INCLUDE}) +#message(STATUS "include_directories for ${NAMES}: ${LIB_TO_INCLUDE}") +#find_library(LIB_TO_INCLUDE /glade/scratch/negins/baghale6/bld/intel/mpt/nodebug/nothreads/nuopc/nuopc/esmf/lib/) +#message(STATUS "include_directories: ${LIB_TO_INCLUDE}") +#target_link_libraries (${LIB_TO_INCLUDE}) + + # Local CMake modules if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") @@ -30,9 +187,29 @@ set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${dialect}") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_COMPILER_LINE}") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${ESMF_LINK_LINE} -g -cpp") -# TODO: This should not be necessary but certain header files are missing from the build -set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I /usr/include/ -I/usr/src/lilac/external/esmf/src/Infrastructure/Util/include -I/usr/src/lilac/external/esmf/build_config/Linux.gfortran.default -I /usr/src/lilac/external/esmf/src/include") -message("CMAKE_Fortran_FLAGS:" ${CMAKE_Fortran_FLAGS}) -add_subdirectory(lilac) -add_subdirectory(tests) + +message(STATUS "==============================================================") +message(STATUS "Fortran Compiler : ${CMAKE_Fortran_COMPILER}") +message(STATUS "cmake Fortran Flags : ${CMAKE_Fortran_FLAGS}") +message(STATUS "==============================================================") +message(STATUS "==============================================================") + + +#add_executable("lilac.exe" ../lilac/*.F90) + +# +# Compile. +# + +file(GLOB_RECURSE SOURCES lilac/*.F90) +#add_subdirectory(lilac) +#add_executable(${PROJECT_NAME}.exe ../lilac/demo_driver.F90 +# ../lilac/lilac_mod.F90 ../lilac/atmos_cap.F90 ../lilac/lilac_utils.F90 +# ../lilac/lnd_cap.F90 ../lilac/cpl_mod.F90) + +add_executable (${PROJECT_NAME}.exe ${SOURCES}) +target_link_libraries(${PROJECT_NAME}.exe ${LIB_TO_INCLUDE}) + +#add_subdirectory(lilac) +#add_subdirectory(tests) diff --git a/lilac/Dockerfile b/lilac/Dockerfile index bebcc00428..cdd4200a64 100644 --- a/lilac/Dockerfile +++ b/lilac/Dockerfile @@ -1,19 +1,17 @@ -FROM centos:latest +FROM jhamman/esmf:latest LABEL description="LILAC development environment" RUN yum install -y curl RUN yum upgrade -y RUN yum update -y RUN yum clean all -RUN yum -y install wget bzip2 gcc gcc-c++ gcc-gfortran mpich-devel make git -ENV PATH="/usr/lib64/mpich/bin:${PATH}" +RUN yum -y install wget bzip2 WORKDIR /usr/src/lilac/ RUN mkdir -p external RUN mkdir -p ci -COPY external/esmf external/esmf COPY external/pfunit external/pfunit COPY ci/* ci/ @@ -21,10 +19,8 @@ COPY ci/* ci/ ENV PATH /usr/local/miniconda/bin:$PATH RUN ./ci/install_python.sh -# Install ESMF -RUN ./ci/install_esmf.sh ENV ESMF_CONFIG_FILE /usr/local/lib/esmf.mk # Install PFUNIT -# RUN ./ci/install_pfunit.sh -# ENV PFUNIT_INSTALL /usr/pfunit +RUN ./ci/install_pfunit.sh +ENV PFUNIT_INSTALL /usr/pfunit diff --git a/lilac/ci/build_and_test_lilac.sh b/lilac/ci/build_and_test_lilac.sh index 3b7fca20f5..6ed3c17e6e 100755 --- a/lilac/ci/build_and_test_lilac.sh +++ b/lilac/ci/build_and_test_lilac.sh @@ -16,4 +16,8 @@ make VERBOSE=1 # -j 4 echo "done building lilac, time to run the tests..." # run test suite -ctest \ No newline at end of file +ctest + +# run system tests +# TODO: these should probably be run via ctest +/lilac/build/tests/rand_atm_rand_lnd/rand_atm_rand_lnd \ No newline at end of file diff --git a/lilac/docker-compose.yml b/lilac/docker-compose.yml index 422b0bc607..8bd538f458 100644 --- a/lilac/docker-compose.yml +++ b/lilac/docker-compose.yml @@ -7,4 +7,3 @@ services: volumes: - .:/lilac command: /lilac/ci/build_and_test_lilac.sh - diff --git a/lilac/lilac/.gitignore b/lilac/lilac/.gitignore new file mode 100644 index 0000000000..d52decad68 --- /dev/null +++ b/lilac/lilac/.gitignore @@ -0,0 +1,5 @@ +*.o +job_name* +PET* +*.exe +batch.sub diff --git a/lilac/lilac/CMakeLists.txt b/lilac/lilac/CMakeLists.txt deleted file mode 100644 index a92669e0ff..0000000000 --- a/lilac/lilac/CMakeLists.txt +++ /dev/null @@ -1,4 +0,0 @@ -# Compile LILAC library -file(GLOB_RECURSE LILAC_SOURCES *.f90 *.h) -add_library(lilac ${LILAC_SOURCES}) -target_include_directories(lilac PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}) diff --git a/lilac/lilac/Makefile b/lilac/lilac/Makefile new file mode 100644 index 0000000000..feab757abf --- /dev/null +++ b/lilac/lilac/Makefile @@ -0,0 +1,99 @@ + +#================================================================================ +# Makefile to compile the lilac program +#================================================================================ +## This is temporary Makefile for building lilac against CTSM pre-compiled library + + + +#================================================================================ +### Finding and including esmf.mk +#================================================================================ + +# Note: This fully portable Makefile template depends on finding environment +# # variable "ESMFMKFILE" set to point to the appropriate "esmf.mk" file, +# # as is discussed in the User's Guide. +# # However, you can still use this Makefile template even if the person +# # that installed ESMF on your system did not provide for a mechanism to +# # automatically set the environment variable "ESMFMKFILE". In this case +# # either manually set "ESMFMKFILE" in your environment or hard code the +# # location of "esmf.mk" into the include statement below. +# # Notice that the latter approach has negative impact on flexibility and +# # portability. + + +ifneq ($(origin ESMFMKFILE), environment) +$(error Environment variable ESMFMKFILE was not set.) +endif + +include $(ESMFMKFILE) + +#================================================================================ +### Define directory paths +#================================================================================ +# Temporarily hard-coded +# TODO: Please fix this part. +CASE_NAME = why01-g +#CASE_NAME = ctsm1.0.dev066_MCT_I2000Clm50SpRsGs_testing +#CASE_NAME = ctsm1.0.dev066_MCT_I2000Clm50Sp_03 +#CASE_NAME = lilac_ctsm +CTSM_BLD_DIR = /glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf +CTSM_INC = -I$(CTSM_BLD_DIR)/include +CTSM_LIB = -L$(CTSM_BLD_DIR)/lib -lclm +#TRACEBACK_FLAGS = -g -traceback -debug all -check all -O2 -r8 +#TRACEBACK_FLAGS = -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -qopt-report -xCORE_AVX2 -no-fma -O2 -debug minimal -DLINUX -DCESMCOUPLED -DFORTRANUNDERSCORE -DCPRINTEL -DNDEBUG -DUSE_ESMF_LIB -DMCT_INTERFACE -DHAVE_MPI -DPIO1 -DHAVE_SLASHPROC -D_PNETCDF -DESMF_VERSION_MAJOR=8 -DESMF_VERSION_MINOR=0 -DATM_PRESENT -DICE_PRESENT -DLND_PRESENT -DOCN_PRESENT -DROF_PRESENT -DGLC_PRESENT -DWAV_PRESENT -DESP_PRESENT -free -DUSE_CONTIGUOUS=contiguous +#TRACEBACK_FLAGS = -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -qopt-report -xCORE_AVX2 -no-fma -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -DLINUX -DCESMCOUPLED -DFORTRANUNDERSCORE -DCPRINTEL -DDEBUG -DUSE_ESMF_LIB -DPIO1 -DHAVE_SLASHPROC -D_PNETCDF -DESMF_VERSION_MAJOR=7 -DESMF_VERSION_MINOR=1 -DATM_PRESENT -DICE_PRESENT -DLND_PRESENT -DOCN_PRESENT -DROF_PRESENT -DGLC_PRESENT -DWAV_PRESENT -DESP_PRESENT -free -DUSE_CONTIGUOUS=contiguous +TRACEBACK_FLAGS = -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -qopt-report -xCORE_AVX2 -no-fma -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -DLINUX -DCESMCOUPLED -DFORTRANUNDERSCORE -DCPRINTEL -DDEBUG -DUSE_ESMF_LIB -DMCT_INTERFACE -DHAVE_MPI -DPIO1 -DHAVE_SLASHPROC -D_PNETCDF -DESMF_VERSION_MAJOR=7 -DESMF_VERSION_MINOR=1 -DATM_PRESENT -DICE_PRESENT -DLND_PRESENT -DOCN_PRESENT -DROF_PRESENT -DGLC_PRESENT -DWAV_PRESENT -DESP_PRESENT -free -DUSE_CONTIGUOUS=contiguous + +# ----------------------------------------------------------------------------- +#EXTRA_LIBS = $(EXTRA_LIBS) -I/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/nuopc/pio/pio2 +EXTRA_LIBS = -L/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/lib -lcsm_share -L/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/lib -lpio -lgptl -lmct -lmpeu -mkl=cluster -L/glade/u/apps/ch/opt/pnetcdf/1.11.0/mpt/2.19/intel/19.0.2//lib -lpnetcdf -L/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -L/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -L/glade/u/home/dunlap/YAML-INSTALL/lib -Wl,-rpath,/glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default -Wl,-rpath,/glade/u/apps/ch/opt/netcdf-mpi/4.6.1/mpt/2.19/intel/19.0.2/lib -Wl,-rpath,/glade/u/home/dunlap/YAML-INSTALL/lib -lesmf -cxxlib -lrt -ldl -lnetcdff -lnetcdf -lyaml-cpp -cxxlib +MORE_LIBS = -I/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -L/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ -I/glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/clm/obj/ -I//glade/scratch/negins/$(CASE_NAME)/bld/intel/mpt/debug/nothreads/mct/mct/esmf/c1a1l1i1o1r1g1w1i1e1/csm_share/ +# ----------------------------------------------------------------------------- + + +#================================================================================ +### Compiler and linker rules using ESMF_ variables supplied by esmf.mk +#================================================================================ + +.SUFFIXES: .f90 .F90 .c .C + +%.o : %.f90 + $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ + $(ESMF_F90COMPILEFREENOCPP) $< + +%.o : %.F90 + $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ + $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) \ + $(CTSM_INC) $(CTSM_LIB) $(TRACEBACK_FLAGS) \ + $(EXTRA_LIBS) $(MORE_LIBS) $< + +%.o : %.c + $(ESMF_CXXCOMPILER) -c $(ESMF_CXXCOMPILEOPTS) $(ESMF_CXXCOMPILEPATHSLOCAL) \ + $(ESMF_CXXCOMPILEPATHS) $(ESMF_CXXCOMPILECPPFLAGS) $< + +% : %.C + $(ESMF_CXXCOMPILER) -c $(ESMF_CXXCOMPILEOPTS) $(ESMF_CXXCOMPILEPATHSLOCAL) \ + $(ESMF_CXXCOMPILEPATHS) $(ESMF_CXXCOMPILECPPFLAGS) $< + +demo_driver: demo_driver.o atmos_cap.o lilac_mod.o lilac_utils.o cpl_mod.o lnd_cap.o + $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) -o $@ $^ $(ESMF_F90ESMFLINKLIBS) $(CTSM_INC) $(CTSM_LIB) $(EXTRA_LIBS) $(TRACEBACK_FLAGS) $(MORE_LIBS) + mv demo_driver demo_driver.exe + rm *.o *.mod + +# module dependencies: +#demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o shr_string_mod.o shr_kind_mod.o shr_sys_mod.o shr_log_mod.o shr_timer_mod.o +demo_driver.o: lilac_mod.o atmos_cap.o lilac_utils.o cpl_mod.o demo_utils.o demo_mod.o +lilac_mod.o: atmos_cap.o lilac_utils.o cpl_mod.o lnd_cap.o #shr_pio_mod.o +atmos_cap.o: lilac_utils.o +demo_mod.o: +# ----------------------------------------------------------------------------- + +.PHONY: clean berzerk remake +clean: + rm -f *.exe *.o +berzerk: + rm -f PET*.ESMF_LogFile job_name* *.o *.mod *.exe +remake: + rm lilac_mod.o demo_driver.o demo_driver.exe & make +# ----------------------------------------------------------------------------- diff --git a/lilac/lilac/atmos_cap.F90 b/lilac/lilac/atmos_cap.F90 new file mode 100644 index 0000000000..c56c66cfe7 --- /dev/null +++ b/lilac/lilac/atmos_cap.F90 @@ -0,0 +1,297 @@ +module atmos_cap + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! This is a dummy atmosphere cap for setting up lilac structure. + + ! !USES + use ESMF + use lilac_utils , only : fld_list_type + use spmdMod , only : masterproc + use clm_varctl , only : iulog + implicit none + + include 'mpif.h' + + character(*), parameter :: modname = "atmos_cap" + !!integer, parameter :: fldsMax = 100 + type(ESMF_Field), public , save :: field + type(fld_list_type), public , allocatable :: c2a_fldlist(:) + type(fld_list_type), public , allocatable :: a2c_fldlist(:) + integer , public , allocatable :: dummy_gindex_atm(:) + + integer :: a2c_fldlist_num + integer :: c2a_fldlist_num + public :: atmos_register + !real(kind=ESMF_KIND_R8), dimension(:), public, pointer, save :: fldptr + integer :: mpierror, numprocs + integer :: i, myid + integer status(MPI_STATUS_SIZE) ! Status of message + integer, parameter :: debug = 1 ! internal debug leve + + + + character(len=128) :: fldname + integer, parameter :: begc = 1 !-- internal debug level + integer, parameter :: endc = 3312/4/2/2 !-- internal debug level + character(*),parameter :: F02 = "('[atmos_cap]',a,i5,2x,d26.19)" + + !======================================================================== + contains + !======================================================================== + + subroutine atmos_register (comp, rc) + + type(ESMF_GridComp) :: comp ! must not be optional + integer, intent(out) :: rc + character(len=*), parameter :: subname=trim(modname)//':(atmos_register) ' + + !------------------------------------------------------------------------- + + print *, "in user register routine" + + ! Initialize return code + rc = ESMF_SUCCESS + + ! Set the entry points for standard ESMF Component methods + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=atmos_init, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=atmos_run, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=atmos_final, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + end subroutine atmos_register + + + + subroutine atmos_init (comp, lnd2atm_a_state, atm2lnd_a_state, clock, rc) + + type (ESMF_GridComp) :: comp + type (ESMF_State) :: lnd2atm_a_state, atm2lnd_a_state + type (ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + type (ESMF_FieldBundle) :: c2a_fb , a2c_fb + integer :: n + type(ESMF_Mesh) :: atmos_mesh + type(ESMF_Mesh) :: atmos_mesh_tmp + character(len=ESMF_MAXSTR) :: atmos_mesh_filepath + integer :: petCount, localrc, urc + integer :: mid, by2, quart, by4 + type(ESMF_Grid) :: atmos_grid + type(ESMF_DistGrid) :: atmos_distgrid + logical :: mesh_switch + character(len=*), parameter :: subname=trim(modname)//': [atmos_init] ' + !integer :: regDecomp(:,:) + + !------------------------------------------------------------------------- + ! Initialize return code + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//"------------------------!", ESMF_LOGMSG_INFO) + + call ESMF_GridCompGet (comp, petcount=petcount, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + !------------------------------------------------------------------------- + ! Read in the mesh ----or----- Generate the grid + !------------------------------------------------------------------------- + mesh_switch = .True. + call MPI_Comm_size(MPI_COMM_WORLD, numprocs, mpierror) + call MPI_Comm_rank(MPI_COMM_WORLD, myid, mpierror) + + + + if(mesh_switch) then + ! TODO: hard-coded mesh file name shoulb be corrected. + ! For now this is our dummy mesh: + !atmos_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' !! Negin: This did not work.... + !atmos_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/fv1.9x2.5_141008_ESMFmesh.nc' + atmos_mesh_filepath = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' + + + atmos_mesh_tmp = ESMF_MeshCreate(filename=trim(atmos_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Mesh for atmosphere is created!", ESMF_LOGMSG_INFO) + !print *, "!Mesh for atmosphere is created!" + + atmos_distgrid = ESMF_DistGridCreate (arbSeqIndexList=dummy_gindex_atm, rc=rc) + + ! recreate the mesh using the above distgrid + atmos_mesh = ESMF_MeshCreate(atmos_mesh_tmp, elementDistgrid=atmos_distgrid, rc=rc) + + else + !TODO: Fix how you want to create the grid here if mesh_switch is off + !atmos_grid= ESMF_GridCreateNoPeriDimUfrmR( maxIndex=(/180,360 /), & + ! minCornerCoord=(/0._ESMF_KIND_R8, 0._ESMF_KIND_R8/), & + ! maxCornerCoord=(/180._ESMF_KIND_R8, 360._ESMF_KIND_R8/), & + ! regDecomp=(/petcount,1/), rc=rc) + + atmos_grid = ESMF_GridCreateNoPeriDimUfrm( minIndex= (/1,1/), maxIndex=(/180,360 /), & + maxCornerCoord=(/180._ESMF_KIND_R8, 360._ESMF_KIND_R8/), & + minCornerCoord=(/0._ESMF_KIND_R8, 0._ESMF_KIND_R8/), & + coordSys=ESMF_COORDSYS_CART,& + regDecomp=(/1,petcount/),& + rc=rc) + call ESMF_LogWrite(subname//"Grid for atmosphere is created!", ESMF_LOGMSG_INFO) + !print *, "Grid for atmosphere is created!" + endif + + !------------------------------------------------------------------------- + ! Atmosphere to Coupler (land) Fields -- atmos --> land + ! I- Create empty field bundle -- a2c_fb + ! II- Create Fields and add them to field bundle + ! III - Add a2c_fb to state (atm2lnd_a_state) + !------------------------------------------------------------------------- + + a2c_fb = ESMF_FieldBundleCreate(name="a2c_fb", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + ! Create individual fields and add to field bundle -- a2c + + a2c_fldlist_num = 17 + + do n = 1,a2c_fldlist_num + + ! create field + !!! Here we want to pass pointers + !field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(a2c_fldlist(n)%stdname), rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(a2c_fldlist(n)%stdname), farrayPtr=a2c_fldlist(n)%farrayptr1d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !call ESMF_FieldFill(field, dataFillScheme = "sincos" , rc=rc) + !call ESMF_FieldFill(field, dataFillScheme = "const" , const1=real(n, ESMF_KIND_R8), rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if (myid == 0 .and. debug > 0) then + print *, "***************************************************" + print *, "Here we are printing field!" + print *, "creating field for a2c:" + print *, trim(a2c_fldlist(n)%stdname) + print *, a2c_fldlist(n)%farrayptr1d + !call ESMF_FieldPrint(field, rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + end if + + !call ESMF_LogWrite(subname//"fieldget!", ESMF_LOGMSG_INFO) + !call ESMF_FieldGet(field, rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + ! add field to field bundle + call ESMF_FieldBundleAdd(a2c_fb, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + enddo + + if (myid == 0 .and. debug > 0) then + do n = 1,a2c_fldlist_num + do i=begc, endc + fldname = a2c_fldlist(n)%stdname + write (iulog,F02)'import: nstep, n, '//trim(fldname)//' = ',i, a2c_fldlist(n)%farrayptr1d(i) + enddo + enddo + end if + + call ESMF_LogWrite(subname//"fieldbundleadd is finished .... !", ESMF_LOGMSG_INFO) + print *, "!Fields to Coupler (atmos to land ) (a2c_fb) Field Bundle Created!" + + ! Add field bundle to state + call ESMF_StateAdd(atm2lnd_a_state, (/a2c_fb/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"atm2lnd_a_state is filled with dummy_var field bundle!", ESMF_LOGMSG_INFO) + print *, "!atm2lnd_a_state is filld with dummy_var field bundle!" + + !------------------------------------------------------------------------- + ! Coupler (land) to Atmosphere Fields -- c2a + ! I- Create Field Bundle -- c2a_fb for because we are in atmos + ! II- Create Fields and add them to field bundle + ! III - Add c2a_fb to state (lnd2atm_a_state) + !------------------------------------------------------------------------- + + c2a_fb = ESMF_FieldBundleCreate (name="c2a_fb", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + ! Create individual fields and add to field bundle -- c2a + c2a_fldlist_num = 12 + + do n = 1,c2a_fldlist_num + + ! create field + if (mesh_switch) then + field = ESMF_FieldCreate(atmos_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(c2a_fldlist(n)%stdname), rc=rc) + !field = ESMF_FieldCreate(atmos_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(c2a_fldlist(n)%stdname), farrayPtr=c2a_fldlist(n)%farrayptr1d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + else + field = ESMF_FieldCreate(atmos_grid, name=trim(c2a_fldlist(n)%stdname), farrayPtr=c2a_fldlist(n)%farrayptr2d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + end if + + ! add field to field bundle + call ESMF_FieldBundleAdd(c2a_fb, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + if (myid == 0 .and. debug > 0) then + print *, "creating field for c2a:" + print *, n + print *, trim(c2a_fldlist(n)%stdname) + print *, c2a_fldlist(n)%farrayptr1d + call ESMF_FieldPrint(field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + end if + enddo + + call ESMF_LogWrite(subname//"c2a fieldbundleadd is finished .... !", ESMF_LOGMSG_INFO) + + ! Add field bundle to state + call ESMF_StateAdd(lnd2atm_a_state, (/c2a_fb/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + ! Set Attributes needed by land + call ESMF_AttributeSet(lnd2atm_a_state, name="nextsw_cday", value=11, rc=rc) + + end subroutine atmos_init + + subroutine atmos_run(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//': [atmos_run] ' + + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"Should atmos_run ", ESMF_LOGMSG_INFO) + end subroutine atmos_run + + subroutine atmos_final(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//': [atmos_final] ' + type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle + + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_StateGet(importState, "c2a_fb", import_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_StateGet(exportState, "a2c_fb", export_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail ou + + + call ESMF_FieldBundleDestroy(import_fieldbundle, rc=rc) + call ESMF_FieldBundleDestroy(export_fieldbundle, rc=rc) + + call ESMF_LogWrite(subname//"?? Are there any other thing for destroying in atmos_final??", ESMF_LOGMSG_INFO) + + end subroutine atmos_final + +end module atmos_cap diff --git a/lilac/lilac/core.f90 b/lilac/lilac/core.f90 deleted file mode 100644 index 91ff33fd6c..0000000000 --- a/lilac/lilac/core.f90 +++ /dev/null @@ -1,317 +0,0 @@ -module lilac - - use ESMF - use esmf_utils - - implicit none - - character(*), parameter :: modname = "(core)" - - !-------------------------------------------------------------------------- - ! Public interfaces - !-------------------------------------------------------------------------- - public :: init - public :: run - public :: final - - private :: atmos_register - private :: land_register - private :: cpl_register - - type, public :: LilacType - private - - type(ESMFInfoType) :: esmf_info - character(len=ESMF_MAXSTR) :: name - - contains - procedure, public :: init => init - procedure, public :: run => run - procedure, public :: final => final - - ! register methods - procedure, nopass, private :: atmos_register => atmos_register - procedure, nopass, private :: land_register => land_register - procedure, nopass, private :: cpl_register => cpl_register - - ! Init methods - procedure, nopass, private :: atmos_init => atmos_init - procedure, nopass, private :: land_init => land_init - procedure, nopass, private :: coupler_init => coupler_init - - ! Run methods - procedure, nopass, private :: atmos_copy_atm_to_lilac => atmos_copy_atm_to_lilac - procedure, nopass, private :: atmos_copy_lilac_to_atm => atmos_copy_lilac_to_atm - procedure, nopass, private :: land_run => land_run - procedure, nopass, private :: coupler_run => coupler_run - - ! Final methods - procedure, nopass, private :: atmos_final => atmos_final - procedure, nopass, private :: land_final => land_final - procedure, nopass, private :: coupler_final => coupler_final - - end type LilacType - -contains - - subroutine init(self, name) - implicit none - class(LilacType), intent(inout) :: self - character(len=ESMF_MAXSTR), intent(in) :: name - - character(len=*), parameter :: subname=trim(modname)//':(init) ' - - call ESMF_LogWrite(subname//"Initializing lilac", ESMF_LOGMSG_INFO) - - self%name = trim(name) - - ! Initialize ESMF structures - call self%esmf_info%init(name, atmos_register, land_register, cpl_register) - - end subroutine init - - subroutine run(self) - implicit none - class(LilacType), intent(inout) :: self - - character(len=*), parameter :: subname=trim(modname)//':(run) ' - - call ESMF_LogWrite(subname//"Running lilac", ESMF_LOGMSG_INFO) - - call self%esmf_info%run() - - end subroutine run - - subroutine final(self) - implicit none - class(LilacType), intent(inout) :: self - - character(len=*), parameter :: subname=trim(modname)//':(final) ' - - call ESMF_LogWrite(subname//"Finalizing lilac", ESMF_LOGMSG_INFO) - - call self%esmf_info%final() - - end subroutine final - - subroutine atmos_register(comp, rc) - type(ESMF_GridComp) :: comp ! must not be optional - integer, intent(out) :: rc ! must not be optional - character(len=*), parameter :: subname=trim(modname)//':(atmos_register) ' - - ! Set the entry points for standard ESMF Component methods - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - userRoutine=atmos_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - userRoutine=atmos_copy_atm_to_lilac, phase=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - userRoutine=atmos_copy_lilac_to_atm, phase=2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - userRoutine=atmos_final, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - rc = ESMF_SUCCESS - - end subroutine atmos_register - - subroutine land_register(comp, rc) - type(ESMF_GridComp) :: comp ! must not be optional - integer, intent(out) :: rc ! must not be optional - character(len=*), parameter :: subname=trim(modname)//':(lnd_register) ' - - ! land_* comes from ctsm esmf cap - - ! Set the entry points for standard ESMF Component methods - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=land_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=land_run, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=land_final, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - rc = ESMF_SUCCESS - - end subroutine land_register - - subroutine cpl_register(comp, rc) - type(ESMF_CplComp) :: comp ! must not be optional - integer, intent(out) :: rc ! must not be optional - character(len=*), parameter :: subname=trim(modname)//':(cpl_register) ' - - rc = ESMF_FAILURE - - ! Register the callback routines. - call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=coupler_init, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=coupler_run, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_CplCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=coupler_final, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_LogWrite(subname//"CouplerMod: Registered Initialize, Run, and Finalize routines", ESMF_LOGMSG_INFO) - - rc = ESMF_SUCCESS - - end subroutine cpl_register - - subroutine atmos_init(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(atmos_init) ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"atmos_init has not been implemented yet", ESMF_LOGMSG_INFO) - - end subroutine atmos_init - - subroutine land_init(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(land_init) ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"land_init has not been implemented yet", ESMF_LOGMSG_INFO) - - end subroutine land_init - - subroutine coupler_init(comp, importState, exportState, clock, rc) - type(ESMF_CplComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(coupler_init) ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"coupler_init has not been implemented yet", ESMF_LOGMSG_INFO) - - end subroutine coupler_init - - subroutine atmos_copy_atm_to_lilac(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(atmos_copy_atm_to_lilac) ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"atmos_copy_atm_to_lilac has not been implemented yet", ESMF_LOGMSG_INFO) - - end subroutine atmos_copy_atm_to_lilac - - subroutine atmos_copy_lilac_to_atm(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(atmos_copy_lilac_to_atm) ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"atmos_copy_lilac_to_atm has not been implemented yet", ESMF_LOGMSG_INFO) - - end subroutine atmos_copy_lilac_to_atm - - subroutine land_run(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(land_run) ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"land_run has not been implemented yet", ESMF_LOGMSG_INFO) - - end subroutine land_run - - subroutine coupler_run(comp, importState, exportState, clock, rc) - type(ESMF_CplComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(coupler_run) ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"coupler_run has not been implemented yet", ESMF_LOGMSG_INFO) - - end subroutine coupler_run - - subroutine atmos_final(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(atmos_final) ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"atmos_final has not been implemented yet", ESMF_LOGMSG_INFO) - - end subroutine atmos_final - - subroutine land_final(comp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(land_final) ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"land_final has not been implemented yet", ESMF_LOGMSG_INFO) - - end subroutine land_final - - subroutine coupler_final(comp, importState, exportState, clock, rc) - type(ESMF_CplComp) :: comp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=*), parameter :: subname=trim(modname)//':(coupler_final) ' - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname//"coupler_final has not been implemented yet", ESMF_LOGMSG_INFO) - - end subroutine coupler_final - -end module lilac diff --git a/lilac/lilac/cpl_mod.F90 b/lilac/lilac/cpl_mod.F90 new file mode 100644 index 0000000000..0fbe51677c --- /dev/null +++ b/lilac/lilac/cpl_mod.F90 @@ -0,0 +1,362 @@ +module cpl_mod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module containing all routines for both couplers + ! 1- coupler 1 : atm ---> lnd (cpl_atm2lnd) + ! 2- coupler 2 : lnd ---> atm (cpl_lnd2atm) + !----------------------------------------------------------------------- + ! !USES + use ESMF + use clm_varctl , only : iulog + implicit none + + include 'mpif.h' + + private + + + public :: cpl_atm2lnd_register + public :: cpl_lnd2atm_register + + character(*), parameter :: modname = " cpl_mod" + type(ESMF_RouteHandle), save :: rh_atm2lnd, rh_lnd2atm + + + integer :: mpierror, numprocs + integer :: i, myid + integer status(MPI_STATUS_SIZE) + + character(len=128) :: fldname + integer, parameter :: begc = 1 !-- internal debug level + integer, parameter :: endc = 3312/4/2/2 !-- internal debug level + character(*),parameter :: F01 = "('[cpl_mod] ',a,i5,2x,i5,2x,d21.14)" + character(*),parameter :: F02 = "('[cpl_mod]',a,i5,2x,d26.19)" + integer, parameter :: debug = 1 !-- internaldebug level + !====================================================================== + contains + !====================================================================== + + subroutine cpl_atm2lnd_register(cplcomp, rc) + type(ESMF_CplComp ) :: cplcomp + integer, intent(out ) :: rc + character(len=* ) , parameter :: subname=trim(modname ) //' : [cpl_atm2lnd_register] ' + + rc = ESMF_SUCCESS + print *, "in cpl_atm2lnd_register routine" + + ! Register the callback routines. + ! Set the entry points for coupler ESMF Component methods + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, userRoutine= cpl_atm2lnd_init, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN , userRoutine=cpl_atm2lnd_run , rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE , userRoutine=cpl_atm2lnd_final, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + end subroutine cpl_atm2lnd_register + + subroutine cpl_lnd2atm_register(cplcomp, rc) + type(ESMF_CplComp ) :: cplcomp + integer, intent(out ) :: rc + character(len=* ) , parameter :: subname=trim(modname ) //' : [cpl_lnd2atm_register] ' + + + rc = ESMF_SUCCESS + print *, "in cpl_lnd2atm_register routine" + + ! Register the callback routines. + ! Set the entry points for coupler ESMF Component methods + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_INITIALIZE, cpl_lnd2atm_init, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_RUN , userRoutine=cpl_lnd2atm_run , rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_CplCompSetEntryPoint(cplcomp, ESMF_METHOD_FINALIZE , userRoutine=cpl_lnd2atm_final, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + end subroutine cpl_lnd2atm_register + + !-------------------------------------------------------------------------- + ! couplers init.... + !-------------------------------------------------------------------------- + + subroutine cpl_atm2lnd_init(cplcomp, importState, exportState, clock, rc) + + type (ESMF_CplComp ) :: cplcomp + type (ESMF_State ) :: importState + type (ESMF_State ) :: exportState + type (ESMF_Clock ) :: clock + type (ESMF_FieldBundle) :: import_fieldbundle, export_fieldbundle + integer, intent(out ) :: rc + character(len=* ) , parameter :: subname=trim(modname) //': [cpl_atm2lnd_init] ' + + rc = ESMF_SUCCESS + print *, "Coupler for atmosphere to land initialize routine called" + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + + call MPI_Comm_size(MPI_COMM_WORLD, numprocs, mpierror) + call MPI_Comm_rank(MPI_COMM_WORLD, myid, mpierror) + + + + call ESMF_StateGet(importState, trim("a2c_fb"), import_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_StateGet(exportState, trim("c2l_fb"), export_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + + if (myid == 0) then + print *, "PRINTING FIELDBUNDLES" + call ESMF_FieldBundlePrint (import_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_FieldBundlePrint (export_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + end if + + + call ESMF_FieldBundleRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) + !call ESMF_FieldBundleRegridStore(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"cpl init finished!", ESMF_LOGMSG_INFO) + end subroutine cpl_atm2lnd_init + + subroutine cpl_lnd2atm_init(cplcomp, importState, exportState, clock, rc) + + type (ESMF_CplComp ) :: cplcomp + type (ESMF_State ) :: importState + type (ESMF_State ) :: exportState + type (ESMF_Clock ) :: clock + type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle + integer, intent(out ) :: rc + character(len=* ) , parameter :: subname=trim(modname ) //': [cpl_lnd2atm_init] ' + + rc = ESMF_SUCCESS + print *, "Coupler for land to atmosphere initialize routine called" + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + + call ESMF_StateGet(importState, "l2c_fb", import_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_StateGet(exportState, "c2a_fb", export_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_FieldBundleRedistStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) + !call ESMF_FieldBundleRegridStore(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"cpl init finished!", ESMF_LOGMSG_INFO) + end subroutine cpl_lnd2atm_init + + !-------------------------------------------------------------------------- + ! Couplers Run phase + !-------------------------------------------------------------------------- + + subroutine cpl_atm2lnd_run(cplcomp, importState, exportState, clock, rc) + + type(ESMF_CplComp ) :: cplcomp + type(ESMF_State ) :: importState + type(ESMF_State ) :: exportState + type(ESMF_Clock ) :: clock + integer, intent(out ) :: rc + type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle + character(len=* ) , parameter :: subname=trim(modname ) //': [cpl_atm2lnd_run] ' + + real, pointer :: fldptr1d(:) + + rc = ESMF_SUCCESS + print *, "Running cpl_atm2lnd_run" + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + + call ESMF_StateGet(importState, trim("a2c_fb"), import_fieldbundle, rc=rc) + !call ESMF_StateGet(importState, itemName=trim("a2c_fb"), item=import_fieldbundle, rc=rc) ! this syntax was not working??? + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//" got a2c fieldbundle!", ESMF_LOGMSG_INFO) + + call ESMF_StateGet(exportState, trim("c2l_fb"), export_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//" got c2l fieldbundle!", ESMF_LOGMSG_INFO) + + !fldname = 'Sa_topo' + !call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + + !call ESMF_FieldBundleRegrid(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) + call ESMF_FieldBundleRedist(import_fieldbundle, export_fieldbundle, routehandle=rh_atm2lnd, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//" regridding fieldbundles from atmos to land!", ESMF_LOGMSG_INFO) + + end subroutine cpl_atm2lnd_run + + + subroutine cpl_lnd2atm_run(cplcomp, importState, exportState, clock, rc) + + type(ESMF_CplComp ) :: cplcomp + type(ESMF_State ) :: importState + type(ESMF_State ) :: exportState + type(ESMF_Clock ) :: clock + integer, intent(out ) :: rc + type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle + character(len=* ) , parameter :: subname=trim(modname ) //': [cpl_lnd2atm_run] ' + + rc = ESMF_SUCCESS + print *, "Running cpl_lnd2atm_run" + call ESMF_LogWrite(subname//"-----------------!", ESMF_LOGMSG_INFO) + + call ESMF_StateGet(importState, "l2c_fb", import_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_StateGet(exportState, "c2a_fb", export_fieldbundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_FieldBundleRedist(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) + !call ESMF_FieldBundleRegrid(import_fieldbundle, export_fieldbundle, routehandle=rh_lnd2atm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//" regridding fieldbundles from land to atmos!", ESMF_LOGMSG_INFO) + + end subroutine cpl_lnd2atm_run + + !-------------------------------------------------------------------------- + ! couplers final phase + !-------------------------------------------------------------------------- + + subroutine cpl_atm2lnd_final(cplcomp, importState, exportState, clock, rc) + + type (ESMF_CplComp ) :: cplcomp + type (ESMF_State ) :: importState + type (ESMF_State ) :: exportState + type (ESMF_Clock ) :: clock + type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle + integer, intent(out ) :: rc + character(len=* ) , parameter :: subname=trim(modname ) //': [cpl_atm2lnd_final] ' + + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"---------------------------------!", ESMF_LOGMSG_INFO) + + ! Only thing to do here is release redist (or regrid) and route handles + call ESMF_FieldBundleRegridRelease (routehandle=rh_atm2lnd, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_LogWrite(subname//" rh_atm2lnd route handle released!", ESMF_LOGMSG_INFO) + + end subroutine cpl_atm2lnd_final + + subroutine cpl_lnd2atm_final(cplcomp, importState, exportState, clock, rc) + + type (ESMF_CplComp ) :: cplcomp + type (ESMF_State ) :: importState + type (ESMF_State ) :: exportState + type (ESMF_Clock ) :: clock + type (ESMF_FieldBundle ) :: import_fieldbundle, export_fieldbundle + integer, intent(out ) :: rc + character(len=* ) , parameter :: subname=trim(modname) //': [cpl_lnd2atm_final] ' + + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"---------------------------------!", ESMF_LOGMSG_INFO) + ! Only thing to do here is release redist (or regrid) and route handles + call ESMF_FieldBundleRegridRelease (routehandle=rh_lnd2atm , rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_LogWrite(subname//" rh_lnd2atm route handle released!", ESMF_LOGMSG_INFO) + + end subroutine cpl_lnd2atm_final + + + !=============================================================================== + + subroutine state_getfldptr(State, fldname, fldptr1d, fldptr2d, rc) + + ! ---------------------------------------------- + ! Get pointer to a state field + ! ---------------------------------------------- + + use ESMF , only : ESMF_State, ESMF_Field, ESMF_Mesh, ESMF_FieldStatus_Flag + use ESMF , only : ESMF_FieldBundle + use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_MeshGet + use ESMF , only : ESMF_FIELDSTATUS_COMPLETE, ESMF_FAILURE + use ESMF , only : ESMF_FieldBundleGet + + ! input/output variables + type(ESMF_State), intent(in) :: State + character(len=*), intent(in) :: fldname + real , pointer, optional , intent(out) :: fldptr1d(:) + real , pointer, optional , intent(out) :: fldptr2d(:,:) + integer, intent(out) :: rc + + ! local variables + type(ESMF_FieldStatus_Flag) :: status + type(ESMF_Field) :: lfield + type(ESMF_Mesh) :: lmesh + integer :: nnodes, nelements + character(len=*), parameter :: subname='(lnd_import_export:state_getfldptr)' + + type(ESMF_StateItem_Flag) :: itemFlag + type(ESMF_FieldBundle) :: fieldBundle + logical :: isPresent + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + ! Determine if this field bundle exist.... + ! TODO: combine the error checks.... + + + call ESMF_StateGet(state, "c2l_fb", itemFlag, rc=rc) + !call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + ! Get the fieldbundle from state... + call ESMF_StateGet(state, "c2l_fb", fieldBundle, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + + call ESMF_FieldBundleGet(fieldBundle,fieldName=trim(fldname), field=lfield, isPresent=isPresent, rc=rc) + !call ESMF_FieldBundleGet(fieldBundle,trim(fldname), lfield, isPresent, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_FieldGet(lfield, status=status, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + if (status /= ESMF_FIELDSTATUS_COMPLETE) then + call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + else + call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + if (nnodes == 0 .and. nelements == 0) then + call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + + if (present(fldptr1d)) then + call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if ( debug > 0) then + write(iulog,F01)' in '//trim(subname)//'fldptr1d for '//trim(fldname)//' is ' + end if + !print *, "FLDPTR1D is" + !print *, FLDPTR1d + else if (present(fldptr2d)) then + call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + else + !call shr_sys_abort("either fldptr1d or fldptr2d must be an input argument") + end if + endif ! status + + + end subroutine state_getfldptr + + + + +end module cpl_mod + diff --git a/lilac/lilac/demo_driver.F90 b/lilac/lilac/demo_driver.F90 new file mode 100644 index 0000000000..2cefc3b73d --- /dev/null +++ b/lilac/lilac/demo_driver.F90 @@ -0,0 +1,464 @@ +module demo_mod +!---------------------------------------------------------------------------- + use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS + use spmdMod , only : masterproc + use lilac_utils , only : atm2lnd_data1d_type , lnd2atm_data1d_type , atm2lnd_data2d_type , atm2lnd_data2d_type , this_clock + implicit none + private + public :: demo_init + public :: read_netcdf_mesh + integer :: ierr + integer :: COMP_COMM + integer :: npts ! domain global size + integer :: num_local + integer :: n_points + real, dimension(:,:), allocatable :: centerCoords +!---------------------------------------------------------------------------- +contains +!---------------------------------------------------------------------------- + subroutine demo_init(gindex_atm, atm2lnd, lnd2atm) + !! TODO: IS THE INTENT CORRECT FOR GINDEX_ATM + integer , allocatable, intent(inout) :: gindex_atm(:) + type (atm2lnd_data1d_type), intent(inout) :: atm2lnd + type (lnd2atm_data1d_type), intent(inout) :: lnd2atm + integer :: ntasks + integer :: mytask + character(len=128) :: filename + integer :: endc + !----------------------------------------------------------------------------- + ! Initiallize MPI + !----------------------------------------------------------------------------- + + npts = 3312 + + write(*, *) "MPI initialization starts ..." + + call MPI_init(ierr) + COMP_COMM = MPI_COMM_WORLD + + !https://github.com/yudong-tian/LIS-CLM4.5SP/blob/8cec515a628325c73058cfa466db63210cd562ac/xlis-bld/xlis_main.F90 + if (ierr .ne. MPI_SUCCESS) then + print *,'Error starting MPI program. Terminating.' + call MPI_ABORT(MPI_COMM_WORLD, ierr) + end if + + ! + + call MPI_COMM_RANK(COMP_COMM, mytask, ierr) + call MPI_COMM_SIZE(COMP_COMM, ntasks, ierr) + + if (mytask == 0 ) then + print *, "MPI initialization done ..., ntasks=", ntasks + end if + + + !----------------------------------------------------------------------------- + ! Read mesh file to get number of points (n_points) + !----------------------------------------------------------------------------- + filename = '/glade/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' + call read_netcdf_mesh(filename, n_points) + + !----------------------------------------------------------------------------- + ! atmosphere domain decomposition + !----------------------------------------------------------------------------- + + npts = n_points + print *, "npts for ", mytask, "is:", npts + call decompInit_atm( ntasks, mytask, gindex_atm) + print *, "gindex_atm for ", mytask,"is: ", gindex_atm + print *, "size gindex_atm for ", mytask,"is: ", size(gindex_atm) + + !----------------------------------------------------------------------------- + ! allocate and fill in atm2lnd + !----------------------------------------------------------------------------- + + endc = npts /ntasks + call fill_in (atm2lnd, lnd2atm, 1, endc, gindex_atm) + end subroutine demo_init + + subroutine decompInit_atm( ntasks, mytask, gindex_atm) + + ! !DESCRIPTION: + ! !USES: + + ! !ARGUMENTS: + integer , intent(in) :: ntasks + integer , intent(in) :: mytask + integer , allocatable, intent(out) :: gindex_atm(:) ! this variable is allocated here, and is assumed to start unallocated + ! !LOCAL VARIABLES: + integer :: my_start + integer :: my_end + integer :: i_local + integer :: i_global + !------------------------------------------------------------------------------ + ! create the a global index array for ocean points + + num_local = npts / ntasks + + my_start = num_local*mytask + min(mytask, mod(npts, ntasks)) + 1 + ! The first mod(npts,ntasks) of ntasks are the ones that have an extra point + if (mytask < mod(npts, ntasks)) then + num_local = num_local + 1 + end if + my_end = my_start + num_local - 1 + + allocate(gindex_atm(num_local)) + + i_global = my_start + do i_local = 1, num_local + gindex_atm(i_local) = i_global + i_global = i_global +1 + end do + + end subroutine decompInit_atm + + subroutine read_netcdf_mesh(filename, n_points) + + use netcdf + implicit none + + ! + ! Parameters + ! + + ! + ! Arguments | Global Variables + ! + character(*) , intent(in) :: filename + integer , intent(inout) :: n_points + + ! + ! Local Variables + ! + + integer :: idfile + + integer :: ierror + integer :: dimid_node + integer :: dimid_elem + integer :: dimid_maxnodepe + integer :: dimid_coordDim + + integer :: iddim_node + integer :: iddim_elem + integer :: iddim_maxnodepe + integer :: iddim_coordDim + + integer :: idvar_nodeCoords + integer :: idvar_CenterCoords + + character (len=100) :: string + + + integer :: nnode + integer :: nelem + integer :: maxnodePE + integer :: coordDim + real, dimension(:,:), allocatable :: nodeCoords + !----------------------------------------------------------------------------- + ! Open mesh file and get the idfile + ierror = nf90_open ( filename, NF90_NOWRITE, idfile) ; call nc_check_err(ierror, "opening file", filename) + + ! Get the dimid of dimensions + ierror = nf90_inq_dimid(idfile, 'nodeCount' , dimid_node ) ; call nc_check_err(ierror, "inq_dimid nodeCount", filename) + ierror = nf90_inq_dimid(idfile, 'elementCount' , dimid_elem ); call nc_check_err(ierror, "inq_dimid elementCount", filename) + ierror = nf90_inq_dimid(idfile, 'maxNodePElement' , dimid_maxnodepe ); call nc_check_err(ierror, "inq_dimid maxNodePElement", filename) + ierror = nf90_inq_dimid(idfile, 'coordDim' , dimid_coordDim ); call nc_check_err(ierror, "coordDim", filename) + + ! Inquire dimensions based on their dimeid(s) + ierror = nf90_inquire_dimension(idfile, dimid_node , string, nnode ); call nc_check_err(ierror, "inq_dim nodeCount", filename) + ierror = nf90_inquire_dimension(idfile, dimid_elem , string, nelem ); call nc_check_err(ierror, "inq_dim elementCount", filename) + ierror = nf90_inquire_dimension(idfile, dimid_maxnodepe , string, maxnodePE ); call nc_check_err(ierror, "inq_dim maxNodePElement", filename) + ierror = nf90_inquire_dimension(idfile, dimid_coordDim , string, coordDim ); call nc_check_err(ierror, "inq_dim coordDim", filename) + + print *, "=======================================" + print *, "nnode is : ", nnode + print *, "nelem is : ", nelem + print *, "coordDim is :", coordDim + print *, "=======================================" + + allocate (nodeCoords(coordDim, nnode)) + allocate (centerCoords(coordDim, nelem)) + ! Get variable IDs (varid) + ierror = nf90_inq_varid(idfile, 'nodeCoords' , idvar_nodeCoords ); call nc_check_err(ierror, "inq_varid nodeCoords", filename) + ierror = nf90_inq_varid(idfile, 'centerCoords' , idvar_centerCoords ); call nc_check_err(ierror, "inq_varid centerCoords", filename) + + ! Get variables values from varids + ierror = nf90_get_var(idfile, idvar_nodeCoords , nodeCoords , start=(/ 1,1/) , count=(/ coordDim, nnode /) ); call nc_check_err(ierror,"get_var nodeCoords", filename) + ierror = nf90_get_var(idfile, idvar_CenterCoords , centerCoords , start=(/ 1,1/) , count=(/ coordDim, nelem /) ); call nc_check_err(ierror,"get_var CenterCoords", filename) + + !print *, "lons : ",centerCoords(1,:) + + n_points = nelem + + end subroutine read_netcdf_mesh + + subroutine nc_check_err(ierror, description, filename) + !------------------------------------------------------------------------------- + ! $HeadURL: https://svn.oss.deltares.nl/repos/delft3d/trunk/src/engines_gpl/wave/packages/data/src/nc_check_err.f90 $ + !!--declarations---------------------------------------------------------------- + use netcdf + ! + implicit none + ! + ! Global variables + ! + integer , intent(in) :: ierror + character(*), intent(in) :: description + character(*), intent(in) :: filename + ! + ! Local variables + ! + ! + ! real, parameter :: PI = 3.1415927 + + !! executable statements ------------------------------------------------------- + ! + if (ierror /= nf90_noerr) then + print *, "ERROR" + write (*,'(6a)') 'ERROR ', trim(description), '. NetCDF file : "', trim(filename), '". Error message:', nf90_strerror(ierror) + endif + end subroutine nc_check_err + + subroutine fill_in (atm2lnd , lnd2atm , begc, endc , gindex_atm) + ! !ARGUMENTS: + type (atm2lnd_data1d_type), intent(inout) :: atm2lnd + type (lnd2atm_data1d_type), intent(inout) :: lnd2atm + + integer , intent(in) :: begc + integer , intent(in) :: endc + + + real :: lat + real :: lon + + integer , allocatable, intent(in) :: gindex_atm(:) + !integer :: i + integer :: i_local + integer :: i_global + + + ! tbot is going to be analytical function + + allocate ( atm2lnd%Sa_z (begc:endc) ) !; atm2lnd%Sa_z (:) = 30.0d0 + allocate ( atm2lnd%Sa_topo (begc:endc) ) !; atm2lnd%Sa_topo (:) = 10.0d0 + allocate ( atm2lnd%Sa_u (begc:endc) ) !; atm2lnd%Sa_u (:) = 20.0d0 + allocate ( atm2lnd%Sa_v (begc:endc) ) !; atm2lnd%Sa_v (:) = 40.0d0 + allocate ( atm2lnd%Sa_ptem (begc:endc) ) !; atm2lnd%Sa_ptem (:) = 280.0d0 + allocate ( atm2lnd%Sa_pbot (begc:endc) ) !; atm2lnd%Sa_pbot (:) = 100100.0d0 + allocate ( atm2lnd%Sa_tbot (begc:endc) ) !; atm2lnd%Sa_tbot (:) = 280.0 + allocate ( atm2lnd%Sa_shum (begc:endc) ) !; atm2lnd%Sa_shum (:) = 0.0004d0 + + allocate ( atm2lnd%Faxa_lwdn (begc:endc) ) !; atm2lnd%Faxa_lwdn (:) = 200.0d0 + allocate ( atm2lnd%Faxa_rainc (begc:endc) ) !; atm2lnd%Faxa_rainc (:) = 0.0d0 + allocate ( atm2lnd%Faxa_rainl (begc:endc) ) !; atm2lnd%Faxa_rainl (:) = 3.0d-8 + allocate ( atm2lnd%Faxa_snowc (begc:endc) ) !; atm2lnd%Faxa_snowc (:) = 1.0d-8 + allocate ( atm2lnd%Faxa_snowl (begc:endc) ) !; atm2lnd%Faxa_snowl (:) = 2.0d-8 + + allocate ( atm2lnd%Faxa_swndr (begc:endc) ) !; atm2lnd%Faxa_swndr (:) = 100.0d0 + allocate ( atm2lnd%Faxa_swvdr (begc:endc) ) !; atm2lnd%Faxa_swvdr (:) = 50.0d0 + allocate ( atm2lnd%Faxa_swndf (begc:endc) ) !; atm2lnd%Faxa_swndf (:) = 20.0d0 + allocate ( atm2lnd%Faxa_swvdf (begc:endc) ) !; atm2lnd%Faxa_swvdf (:) = 40.0d0 + + do i_local = begc, endc + + i_global = gindex_atm(i_local) + lon = centerCoords(1,i_global) + lat = centerCoords(2,i_global) + + ! rounding to nearest int + lon = real(nint(lon)) + lat = real(nint(lat)) + ! This is i_local + print *, "i_local is:", i_local, "i_global is :", i_global, "lon:", lon, "lat:", lat + !atm2lnd%Sa_tbot(i_local) = 280.0d0 + (sin (lat)+ cos(lon))*1.0d0 + !atm2lnd%Sa_tbot(i_local) = 280.0d0 + cos(lon)*1.0d0 + + atm2lnd%Sa_z (i_local) = 30.0d0 + lat *0.01d0 + lon *0.01d0 + atm2lnd%Sa_topo (i_local) = 10.0d0 + lat *0.01d0 + lon *0.01d0 + atm2lnd%Sa_u (i_local) = 20.0d0 + lat *0.01d0 + lon *0.01d0 + atm2lnd%Sa_v (i_local) = 40.0d0 + lat *0.01d0 + lon *0.01d0 + atm2lnd%Sa_ptem (i_local) = 280.0d0 + lat *0.01d0 + lon *0.01d0 + atm2lnd%Sa_pbot (i_local) = 100100.0d0 + lat *0.01d0 + lon *0.01d0 + atm2lnd%Sa_tbot (i_local) = 280.0d0 + lat *0.01d0 + lon *0.01d0 + atm2lnd%Sa_shum (i_local) = 0.0004d0 !+(lat*0.01d0 + lon*0.01d0)*1.0e-8 + atm2lnd%Faxa_lwdn (i_local) = 200.0d0 + lat *0.01d0 + lon *0.01d0 + + !atm2lnd%Faxa_rainc (i_local) = 0.0d0 + (lat*0.01d0 + lon*0.01d0)*1.0e-8 + atm2lnd%Faxa_rainl (i_local) = 3.0d-8 + (lat*0.01d0 + lon*0.01d0)*1.0e-8 + atm2lnd%Faxa_snowc (i_local) = 1.0d-8 + (lat*0.01d0 + lon*0.01d0)*1.0e-8 + atm2lnd%Faxa_snowl (i_local) = 2.0d-8 + (lat*0.01d0 + lon*0.01d0)*1.0e-8 + atm2lnd%Faxa_swndr (i_local) = 100.0d0 + lat *0.01d0 + lon *0.01d0 + atm2lnd%Faxa_swvdr (i_local) = 50.0d0 + lat *0.01d0 + lon *0.01d0 + atm2lnd%Faxa_swndf (i_local) = 20.0d0 + lat *0.01d0 + lon *0.01d0 + atm2lnd%Faxa_swvdf (i_local) = 40.0d0 + lat *0.01d0 + lon *0.01d0 + !atm2lnd%Sa_tbot(i) = 280.0 + sin ( lat )*1.0 + !atm2lnd%Sa_tbot(i) = 280.0 + cos(lon)*1.0 + + ! radian instead of degrees: + !lon = lon* PI/180.0 + !lat = lat* PI/180.0 + end do + + !allocating these values from atmosphere for now! + !allocate ( atm2lnd%Sa_z (begc:endc) ) ; atm2lnd%Sa_z (:) = 30.0d0 + !allocate ( atm2lnd%Sa_topo (begc:endc) ) ; atm2lnd%Sa_topo (:) = 10.0d0 + !allocate ( atm2lnd%Sa_u (begc:endc) ) ; atm2lnd%Sa_u (:) = 20.0d0 + !allocate ( atm2lnd%Sa_v (begc:endc) ) ; atm2lnd%Sa_v (:) = 40.0d0 + !allocate ( atm2lnd%Sa_ptem (begc:endc) ) ; atm2lnd%Sa_ptem (:) = 280.0d0 + !allocate ( atm2lnd%Sa_pbot (begc:endc) ) ; atm2lnd%Sa_pbot (:) = 100100.0d0 + !allocate ( atm2lnd%Sa_tbot (begc:endc) ) ; atm2lnd%Sa_tbot (:) = 280.0d0 + !allocate ( atm2lnd%Sa_shum (begc:endc) ) ; atm2lnd%Sa_shum (:) = 0.0004d0 + !allocate ( atm2lnd%Faxa_lwdn (begc:endc) ) ; atm2lnd%Faxa_lwdn (:) = 200.0d0 + !allocate ( atm2lnd%Faxa_rainc (begc:endc) ) ; atm2lnd%Faxa_rainc (:) = 4.0d-8 + allocate ( atm2lnd%Faxa_rainc (begc:endc) ) ; atm2lnd%Faxa_rainc (:) = 0.0d0 + !allocate ( atm2lnd%Faxa_rainl (begc:endc) ) ; atm2lnd%Faxa_rainl (:) = 3.0d-8 + !allocate ( atm2lnd%Faxa_snowc (begc:endc) ) ; atm2lnd%Faxa_snowc (:) = 1.0d-8 + !allocate ( atm2lnd%Faxa_snowl (begc:endc) ) ; atm2lnd%Faxa_snowl (:) = 2.0d-8 + + !allocate ( atm2lnd%Faxa_swndr (begc:endc) ) ; atm2lnd%Faxa_swndr (:) = 100.0d0 + !allocate ( atm2lnd%Faxa_swvdr (begc:endc) ) ; atm2lnd%Faxa_swvdr (:) = 50.0d0 + !allocate ( atm2lnd%Faxa_swndf (begc:endc) ) ; atm2lnd%Faxa_swndf (:) = 20.0d0 + !allocate ( atm2lnd%Faxa_swvdf (begc:endc) ) ; atm2lnd%Faxa_swvdf (:) = 40.0d0 + !allocate ( atm2lnd%Faxa_bcph (begc:endc) ) ; atm2lnd%Faxa_bcph (:) = 0.0d0 + + + allocate ( lnd2atm%Sl_lfrin (begc:endc) ) ; lnd2atm%Sl_lfrin (:) = 0 + allocate ( lnd2atm%Sl_t (begc:endc) ) ; lnd2atm%Sl_t (:) = 0 + allocate ( lnd2atm%Sl_tref (begc:endc) ) ; lnd2atm%Sl_tref (:) = 0 + allocate ( lnd2atm%Sl_qref (begc:endc) ) ; lnd2atm%Sl_qref (:) = 0 + allocate ( lnd2atm%Sl_avsdr (begc:endc) ) ; lnd2atm%Sl_avsdr (:) = 0 + allocate ( lnd2atm%Sl_anidr (begc:endc) ) ; lnd2atm%Sl_anidr (:) = 0 + allocate ( lnd2atm%Sl_avsdf (begc:endc) ) ; lnd2atm%Sl_avsdf (:) = 0 + allocate ( lnd2atm%Sl_anidf (begc:endc) ) ; lnd2atm%Sl_anidf (:) = 0 + allocate ( lnd2atm%Sl_snowh (begc:endc) ) ; lnd2atm%Sl_snowh (:) = 0 + allocate ( lnd2atm%Sl_u10 (begc:endc) ) ; lnd2atm%Sl_u10 (:) = 0 + allocate ( lnd2atm%Sl_fv (begc:endc) ) ; lnd2atm%Sl_fv (:) = 0 + allocate ( lnd2atm%Sl_ram1 (begc:endc) ) ; lnd2atm%Sl_ram1 (:) = 0 + end subroutine fill_in + +end module demo_mod + + + +program demo_lilac_driver + + !---------------------------------------------------------------------------- + !*** All the components are in the hierarchy seen here: + ! + ! main driver* (WRF) + ! | + ! | + ! lilac (not a gridded component!) + ! | |________________________. + ! | | + ! atmos cap land cap ____________. ......... gridded components + ! | | | + ! | | river cap + ! ocean (MOM, POM)? | | + ! | Mizzouroute... + ! CTSM + ! + ! + !---------------------------------------------------------------------------- + + ! modules + use ESMF + use lilac_mod + use lilac_utils , only : atm2lnd_data1d_type , lnd2atm_data1d_type , atm2lnd_data2d_type , atm2lnd_data2d_type , this_clock + use clm_varctl , only : iulog + use spmdMod , only : masterproc + use demo_mod , only : demo_init + use demo_mod , only : read_netcdf_mesh + implicit none + + ! TO DO: change the name and the derived data types + ! data types for 1d arrays for meshes + type (atm2lnd_data1d_type) :: atm2lnd + type (lnd2atm_data1d_type) :: lnd2atm + + type (this_clock) :: this_time + + real , allocatable :: rand1(:) + real , allocatable :: rand2(:) + + integer , allocatable :: seed(:) + integer :: seed_val, n + + integer :: begc,endc + integer :: start_time !-- start_time start time + integer :: end_time !-- end_time end time + integer :: curr_time !-- cur_time current time + integer :: itime_step !-- itime_step counter of time steps + integer :: g,i,k !-- indices + integer, parameter :: debug = 1 !-- internal debug level + + character(len=128) :: fldname + + character(*),parameter :: F01 = "(a,i4,d26.19)" + character(*),parameter :: F02 = "('[demo_driver]',a,i5,2x,d26.19)" + integer , allocatable :: gindex_atm(:) + + !------------------------------------------------------------------------ + ! real atmosphere: + begc = 1 + !endc = 6912/4/2 + endc = 3312/4/2/2 + !endc = 13824 + !endc = 13968 + + start_time = 1 + end_time = 48 + itime_step = 1 + + seed_val = 0 + n = endc - begc + 1 + + + ! making 2 random arrays with a seed. + call random_seed (size = n ) + allocate ( seed (n ) ) ; seed (:) = seed_val + call random_seed (put = seed ) + + allocate ( rand1 (begc:endc) ) ; call random_number (rand1) + allocate ( rand2 (begc:endc) ) ; call random_number (rand2) + + + !fldname = 'Sa_topo' + !if (debug > 0) then + ! do i=begc, endc + ! write (iulog,F02)'import: nstep, n, '//trim(fldname)//' = ',i, atm2lnd%Sa_topo(i) + ! enddo + ! end if + + + !print *, atm2lnd%Sa_topo(1:100) + + + + !------------------------------------------------------------------------ + ! The newly added demo_init + ! all allocate will go here: + !------------------------------------------------------------------------ + + call demo_init(gindex_atm, atm2lnd , lnd2atm) + + !------------------------------------------------------------------------ + ! looping over imaginary time .... + !------------------------------------------------------------------------ + + call lilac_init ( atm2lnd1d = atm2lnd , lnd2atm1d = lnd2atm , gindex_atm = gindex_atm ) + do curr_time = start_time, end_time + call lilac_run ( ) + itime_step = itime_step + 1 + end do + call lilac_final ( ) + call ESMF_Finalize ( ) + + print *, "=======================================" + print *, " ............. DONE ..................." + print *, "=======================================" + + +end program demo_lilac_driver + diff --git a/lilac/lilac/demo_mod.F90 b/lilac/lilac/demo_mod.F90 new file mode 100644 index 0000000000..7b077afcbf --- /dev/null +++ b/lilac/lilac/demo_mod.F90 @@ -0,0 +1,231 @@ +module demo_mod +!---------------------------------------------------------------------------- + use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS + use spmdMod , only : masterproc + implicit none + private + public :: demo_init + public :: read_netcdf_mesh + integer :: ierr + integer :: COMP_COMM + integer :: npts ! domain global size + integer :: num_local +!---------------------------------------------------------------------------- +contains +!---------------------------------------------------------------------------- + subroutine demo_init(gindex_atm) + !! TODO: IS THE INTENT CORRECT FOR GINDEX_ATM + integer , allocatable, intent(inout) :: gindex_atm(:) + integer :: ntasks + integer :: mytask + !----------------------------------------------------------------------------- + ! Initiallize MPI + !----------------------------------------------------------------------------- + + npts = 3312 + ! this is coming from + ! /glade/work/mvertens/ctsm.nuopc/cime/src/drivers/nuopc/drivers/cime/esmApp.F90 + call MPI_init(ierr) + COMP_COMM = MPI_COMM_WORLD + + !https://github.com/yudong-tian/LIS-CLM4.5SP/blob/8cec515a628325c73058cfa466db63210cd562ac/xlis-bld/xlis_main.F90 + if (ierr .ne. MPI_SUCCESS) then + print *,'Error starting MPI program. Terminating.' + call MPI_ABORT(MPI_COMM_WORLD, ierr) + end if + + ! + + call MPI_COMM_RANK(COMP_COMM, mytask, ierr) + call MPI_COMM_SIZE(COMP_COMM, ntasks, ierr) + + if (masterproc) then + print *, "MPI initialization done ..., ntasks=", ntasks + end if + + call decompInit_atm( ntasks, mytask, gindex_atm) + print *, "gindex_atm for ", mytask,"is: ", gindex_atm + print *, "size gindex_atm for ", mytask,"is: ", size(gindex_atm) + end subroutine demo_init + + subroutine decompInit_atm( ntasks, mytask, gindex_atm) + + ! !DESCRIPTION: + + ! !USES: + + ! !ARGUMENTS: + integer , intent(in) :: ntasks + integer , intent(in) :: mytask + integer , allocatable, intent(out) :: gindex_atm(:) ! this variable is allocated here, and is assumed to start unallocated + ! !LOCAL VARIABLES: + integer :: my_start + integer :: my_end + integer :: i_local + integer :: i_global + !------------------------------------------------------------------------------ + ! create the a global index array for ocean points + + num_local = npts / ntasks + + my_start = num_local*mytask + min(mytask, mod(npts, ntasks)) + 1 + ! The first mod(npts,ntasks) of ntasks are the ones that have an extra point + if (mytask < mod(npts, ntasks)) then + num_local = num_local + 1 + end if + my_end = my_start + num_local - 1 + + allocate(gindex_atm(num_local)) + + i_global = my_start + do i_local = 1, num_local + gindex_atm(i_local) = i_global + i_global = i_global +1 + end do + + end subroutine decompInit_atm + + subroutine read_netcdf_mesh(filename) + + use netcdf + implicit none + + ! + ! Parameters + ! + + ! + ! Arguments | Global Variables + ! + character(*) , intent(in) :: filename + + + ! + ! Local Variables + ! + + integer :: idfile + + integer :: ierror + integer :: dimid_node + integer :: dimid_elem + integer :: dimid_maxnodepe + integer :: dimid_coordDim + + integer :: iddim_node + integer :: iddim_elem + integer :: iddim_maxnodepe + integer :: iddim_coordDim + + integer :: idvar_nodeCoords + integer :: idvar_CenterCoords + + character (len=100) :: string + + + integer :: nnode + integer :: nelem + integer :: maxnodePE + integer :: coordDim + real, dimension(:,:), allocatable :: centerCoords + real, dimension(:,:), allocatable :: nodeCoords + !----------------------------------------------------------------------------- + ! Open mesh file and get the idfile + ierror = nf90_open ( filename, NF90_NOWRITE, idfile) ; call nc_check_err(ierror, "opening file", filename) + + ! Get the dimid of dimensions + ierror = nf90_inq_dimid(idfile, 'nodeCount' , dimid_node ) ; call nc_check_err(ierror, "inq_dimid nodeCount", filename) + ierror = nf90_inq_dimid(idfile, 'elementCount' , dimid_elem ); call nc_check_err(ierror, "inq_dimid elementCount", filename) + ierror = nf90_inq_dimid(idfile, 'maxNodePElement' , dimid_maxnodepe ); call nc_check_err(ierror, "inq_dimid maxNodePElement", filename) + ierror = nf90_inq_dimid(idfile, 'coordDim' , dimid_coordDim ); call nc_check_err(ierror, "coordDim", filename) + + ! Inquire dimensions based on their dimeid(s) + ierror = nf90_inquire_dimension(idfile, dimid_node , string, nnode ); call nc_check_err(ierror, "inq_dim nodeCount", filename) + ierror = nf90_inquire_dimension(idfile, dimid_elem , string, nelem ); call nc_check_err(ierror, "inq_dim elementCount", filename) + ierror = nf90_inquire_dimension(idfile, dimid_maxnodepe , string, maxnodePE ); call nc_check_err(ierror, "inq_dim maxNodePElement", filename) + ierror = nf90_inquire_dimension(idfile, dimid_coordDim , string, coordDim ); call nc_check_err(ierror, "inq_dim coordDim", filename) + + print *, "=======================================" + print *, "nnode is : ", nnode + print *, "nelem is : ", nelem + print *, "coordDim is :", coordDim + print *, "=======================================" + + allocate (nodeCoords(coordDim, nnode)) + allocate (centerCoords(coordDim, nelem)) + ! Get variable IDs (varid) + ierror = nf90_inq_varid(idfile, 'nodeCoords' , idvar_nodeCoords ); call nc_check_err(ierror, "inq_varid nodeCoords", filename) + ierror = nf90_inq_varid(idfile, 'centerCoords' , idvar_centerCoords ); call nc_check_err(ierror, "inq_varid centerCoords", filename) + + ! Get variables values from varids + ierror = nf90_get_var(idfile, idvar_nodeCoords , nodeCoords , start=(/ 1,1/) , count=(/ coordDim, nnode /) ); call nc_check_err(ierror,"get_var nodeCoords", filename) + ierror = nf90_get_var(idfile, idvar_CenterCoords , centerCoords , start=(/ 1,1/) , count=(/ coordDim, nelem /) ); call nc_check_err(ierror,"get_var CenterCoords", filename) + + print *, "lons : ",centerCoords(1,:) + + end subroutine read_netcdf_mesh + +subroutine nc_check_err(ierror, description, filename) +!----- GPL --------------------------------------------------------------------- +! +! Copyright (C) Stichting Deltares, 2011-2018. +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation version 3. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see . +! +! contact: delft3d.support@deltares.nl +! Stichting Deltares +! P.O. Box 177 +! 2600 MH Delft, The Netherlands +! +! All indications and logos of, and references to, "Delft3D" and "Deltares" +! are registered trademarks of Stichting Deltares, and remain the property of +! Stichting Deltares. All rights reserved. +! +!------------------------------------------------------------------------------- +! $Id: nc_check_err.f90 7992 2018-01-09 10:27:35Z mourits $ +! $HeadURL: https://svn.oss.deltares.nl/repos/delft3d/trunk/src/engines_gpl/wave/packages/data/src/nc_check_err.f90 $ +!!--description----------------------------------------------------------------- +! NONE +!!--pseudo code and references-------------------------------------------------- +! NONE +!!--declarations---------------------------------------------------------------- + use netcdf + ! + implicit none +! +! Global variables +! + integer , intent(in) :: ierror + character(*), intent(in) :: description + character(*), intent(in) :: filename +! +! Local variables +! +! +!! executable statements ------------------------------------------------------- +! + if (ierror /= nf90_noerr) then + print *, "ERROR" + write (*,'(6a)') 'ERROR ', trim(description), '. NetCDF file : "', trim(filename), '". Error message:', nf90_strerror(ierror) + endif +end subroutine nc_check_err + + + + + + + +end module demo_mod + + diff --git a/lilac/lilac/demo_utils.F90 b/lilac/lilac/demo_utils.F90 new file mode 100644 index 0000000000..6189145936 --- /dev/null +++ b/lilac/lilac/demo_utils.F90 @@ -0,0 +1,160 @@ +module demo_utils +!---------------------------------------------------------------------------- + use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS + use spmdMod , only : masterproc + implicit none + private + public :: demo_init + public :: read_netcdf_mesh + integer :: ierr + integer :: COMP_COMM + integer :: npts ! domain global size + integer :: num_local +!---------------------------------------------------------------------------- +contains +!---------------------------------------------------------------------------- + subroutine demo_init(gindex_atm) + !! TODO: IS THE INTENT CORRECT FOR GINDEX_ATM + integer , allocatable, intent(inout) :: gindex_atm(:) + integer :: ntasks + integer :: mytask + !----------------------------------------------------------------------------- + ! Initiallize MPI + !----------------------------------------------------------------------------- + + npts = 3312 + ! this is coming from + ! /glade/work/mvertens/ctsm.nuopc/cime/src/drivers/nuopc/drivers/cime/esmApp.F90 + call MPI_init(ierr) + COMP_COMM = MPI_COMM_WORLD + + !https://github.com/yudong-tian/LIS-CLM4.5SP/blob/8cec515a628325c73058cfa466db63210cd562ac/xlis-bld/xlis_main.F90 + if (ierr .ne. MPI_SUCCESS) then + print *,'Error starting MPI program. Terminating.' + call MPI_ABORT(MPI_COMM_WORLD, ierr) + end if + + ! + + call MPI_COMM_RANK(COMP_COMM, mytask, ierr) + call MPI_COMM_SIZE(COMP_COMM, ntasks, ierr) + + if (masterproc) then + print *, "MPI initialization done ..., ntasks=", ntasks + end if + + call decompInit_atm( ntasks, mytask, gindex_atm) + print *, "gindex_atm for ", mytask,"is: ", gindex_atm + print *, "size gindex_atm for ", mytask,"is: ", size(gindex_atm) + end subroutine demo_init + + subroutine decompInit_atm( ntasks, mytask, gindex_atm) + + ! !DESCRIPTION: + + ! !USES: + + ! !ARGUMENTS: + integer , intent(in) :: ntasks + integer , intent(in) :: mytask + integer , allocatable, intent(out) :: gindex_atm(:) ! this variable is allocated here, and is assumed to start unallocated + ! !LOCAL VARIABLES: + integer :: my_start + integer :: my_end + integer :: i_local + integer :: i_global + !------------------------------------------------------------------------------ + ! create the a global index array for ocean points + + num_local = npts / ntasks + + my_start = num_local*mytask + min(mytask, mod(npts, ntasks)) + 1 + ! The first mod(npts,ntasks) of ntasks are the ones that have an extra point + if (mytask < mod(npts, ntasks)) then + num_local = num_local + 1 + end if + my_end = my_start + num_local - 1 + + allocate(gindex_atm(num_local)) + + i_global = my_start + do i_local = 1, num_local + gindex_atm(i_local) = i_global + i_global = i_global +1 + end do + + end subroutine decompInit_atm + + subroutine read_netcdf_mesh(filename) + + use netcdf + implicit none + + ! + ! Parameters + ! + + ! + ! Arguments | Global Variables + ! + character(*) , intent(in) :: filename + + + ! + ! Local Variables + ! + + integer :: idfile + + integer :: ierror + integer :: dimid_node + integer :: dimid_elem + integer :: dimid_maxnodepe + integer :: dimid_coordDim + + integer :: iddim_node + integer :: iddim_elem + integer :: iddim_maxnodepe + integer :: iddim_coordDim + + integer :: idvar_nodeCoords + integer :: idvar_CenterCoords + + character (len=100) :: string + + integer :: nnode + integer :: nelem + integer :: maxnodePE + integer :: coordDim + !----------------------------------------------------------------------------- + ! Open mesh file and get the idfile + ierror = nf90_open ( filename, NF90_NOWRITE, idfile); call nc_check_err(ierror, "opening file", filename) + + ! Get the dimid of dimensions + ierror = nf90_inq_dimid(idfile, 'nodeCount' , dimid_node ); call nc_check_err(ierror, "inq_dimid nodeCount", filename) + ierror = nf90_inq_dimid(idfile, 'elementCount' , dimid_elem ); call nc_check_err(ierror, "inq_dimid elementCount", filename) + ierror = nf90_inq_dimid(idfile, 'maxNodePElement' , dimid_maxnodepe ); call nc_check_err(ierror, "inq_dimid maxNodePElement", filename) + ierror = nf90_inq_dimid(idfile, 'coordDim' , dimid_coordDim ); call nc_check_err(ierror, "coordDim", filename) + + ! Inquire dimensions based on their dimeid(s) + ierror = nf90_inquire_dimension(idfile, iddim_node , string, nnode ); call nc_check_err(ierror, "inq_dim nodeCount", filename) + ierror = nf90_inquire_dimension(idfile, iddim_elem , string, nelem ); call nc_check_err(ierror, "inq_dim elementCount", filename) + ierror = nf90_inquire_dimension(idfile, iddim_maxnodepe , string, maxnodePE ); call nc_check_err(ierror, "inq_dim maxNodePElement", filename) + ierror = nf90_inquire_dimension(idfile, iddim_coordDim , string, coordDim ); call nc_check_err(ierror, "inq_dim coordDim", filename) + + + ! Get variable IDs (varid) + ierror = nf90_inq_varid(idfile, 'nodeCoords' , idvar_nodeCoords ); call nc_check_err(ierror, "inq_varid nodeCoords", filename) + ierror = nf90_inq_varid(idfile, 'CenterCoords' , idvar_CenterCoords ); call nc_check_err(ierror, "inq_varid CenterCoords", filename) + + ! Get variables values from varids + !ierror = nf90_get_var(idfile, idvar_nodeCoords , nodeCoords , start=(/ 1,1/) , count=(/ nnode, coordDim /) ); call nc_check_err(ierror,"get_var nodeCoords", filename) + !ierror = nf90_get_var(idfile, idvar_CenterCoords , CenterCoords , start=(/ 1,1/) , count=(/ nelem, coordDim /) ); call nc_check_err(ierror,"get_var CenterCoords", filename) + + + + + end subroutine read_netcdf_mesh + +end module demo_utils + diff --git a/lilac/lilac/drivers/data_driver.f90 b/lilac/lilac/drivers/data_driver.f90 deleted file mode 100644 index b5cb581d9b..0000000000 --- a/lilac/lilac/drivers/data_driver.f90 +++ /dev/null @@ -1,352 +0,0 @@ - -PROGRAM lilac_data_driver - - use seq_flds_mod , only: & - seq_flds_x2l_states, seq_flds_x2l_fluxes, seq_flds_x2l_fields, & - seq_flds_l2x_states, seq_flds_l2x_fluxes, seq_flds_l2x_fields, & - seq_flds_dom_coord, seq_flds_dom_other, seq_flds_dom_fields - use seq_infodata_mod, only: seq_infodata_type, seq_infodata_putdata, seq_infodata_getdata - use shr_sys_mod , only: shr_sys_flush, shr_sys_abort - use shr_orb_mod , only: shr_orb_params - use shr_file_mod , only: shr_file_setlogunit, shr_file_setloglevel - use shr_pio_mod , only: shr_pio_init1, shr_pio_init2 - use ESMF - - implicit none - -#include ! mpi library include file - - !----- Clocks ----- - type(ESMF_Clock) :: EClock ! Input synchronization clock - type(ESMF_Time) :: CurrTime, StartTime, StopTime - type(ESMF_TimeInterval) :: TimeStep - type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest - type(ESMF_Calendar),target :: Calendar - integer :: yy,mm,dd,sec - - !----- MPI/MCT ----- - integer :: mpicom_clmdrv ! local mpicom - integer :: ID_clmdrv ! mct ID - integer :: ncomps ! number of separate components for MCT - integer :: ntasks,mytask ! mpicom size and rank - integer :: global_comm ! copy of mpi_comm_world for pio - integer,allocatable :: comp_id(:) ! for pio init2 - logical,allocatable :: comp_iamin(:) ! for pio init2 - character(len=64),allocatable :: comp_name(:) ! for pio init2 - integer,allocatable :: comp_comm(:), comp_comm_iam(:) ! for pio_init2 - - !----- Land Coupling Data ----- - ! type(seq_cdata) :: cdata ! Input land-model driver data - ! type(seq_infodata_type),target :: infodata ! infodata type - ! type(mct_aVect) :: x2l, l2x ! land model import and export states - ! type(mct_gGrid),target :: dom_lnd ! domain data for clm - ! type(mct_gsMap),target :: gsmap_lnd ! gsmap data for clm - integer :: orb_iyear ! Orbital - real*8 :: orb_eccen, orb_obliq, orb_mvelp, orb_obliqr, orb_lambm0, orb_mvelpp - character(len=128) :: case_name, case_desc, model_version, hostname, username - character(len=128) :: start_type - logical :: brnch_retain_casename, single_column, atm_aero - real*8 :: scmlat, scmlon - integer :: idx_Sa_z, idx_Sa_u, idx_Sa_v, idx_Sa_tbot, idx_Sa_ptem, & - idx_Sa_shum, idx_Sa_pbot, idx_Faxa_rainc, idx_Faxa_rainl, & - idx_Faxa_snowc, idx_Faxa_snowl, idx_Faxa_lwdn, idx_Faxa_swndr, & - idx_Faxa_swvdr, idx_Faxa_swndf, idx_Faxa_swvdf - - !----- Atm Model ----- - integer :: atm_nx, atm_ny - integer :: gsize, lsize, gstart, gend ! domain decomp info - integer, allocatable :: gindex(:) ! domain decomp info - type(mct_aVect) :: x2l_a ! data for land on atm decomp - type(mct_aVect) :: l2x_a ! data from land on atm decomp - type(mct_gsMap) :: gsmap_atm ! gsmap data for atm - type(mct_rearr) :: rearr_atm2lnd ! rearranger for atm to land - type(mct_rearr) :: rearr_lnd2atm ! rearranger for land to atm - - !----- Other ----- - integer :: n,m ! counter - character(len=128) :: string ! temporary string - integer :: ierr, rc ! local error status - integer :: iunit = 250 ! clmdrv log unit number - integer :: sunit = 249 ! share log unit number - character(len=*),parameter :: subname = 'clmdrv' - - type fld_list_type - character(len=128) :: stdname - end type fld_list_type - - !---------------------------------------------- - - !---------------------------------------------- - !--- MPI/MCT --- - !---------------------------------------------- - - call MPI_Init(ierr) - call MPI_Comm_Dup(MPI_COMM_WORLD, mpicom_clmdrv, ierr) - call MPI_COMM_RANK(mpicom_clmdrv, mytask, ierr) - call MPI_COMM_SIZE(mpicom_clmdrv, ntasks, ierr) - - ncomps = 1 - ID_clmdrv = 1 - call mct_world_init(ncomps,MPI_COMM_WORLD,mpicom_clmdrv,ID_clmdrv) - - !---------------------------------------------- - !--- Log File and PIO --- - !---------------------------------------------- - - global_comm = MPI_COMM_WORLD - call shr_pio_init1(ncomps, 'pio_in', global_comm) - allocate(comp_id(ncomps),comp_name(ncomps),comp_iamin(ncomps),comp_comm(ncomps),comp_comm_iam(ncomps)) - do n = 1,ncomps - comp_id(n) = ID_clmdrv - comp_name(n) = 'LND' - comp_iamin(n) = .true. - comp_comm(n) = mpicom_clmdrv - comp_comm_iam(n) = mytask - enddo - call shr_pio_init2(comp_id, comp_name, comp_iamin, comp_comm, comp_comm_iam) - deallocate(comp_id,comp_name,comp_iamin,comp_comm,comp_comm_iam) - - write(string,'(a,i4.4)') 'clmdrv.log.',mytask - open(iunit, file=trim(string)) - write(iunit,*) subname,' STARTING' - call shr_sys_flush(iunit) - - write(iunit,*) subname,' ntasks = ',ntasks - write(iunit,*) subname,' mytask = ',mytask - write(iunit,*) subname,' mct ID = ',ID_clmdrv - call shr_sys_flush(iunit) - call shr_file_setLogUnit(sunit) - call shr_file_setLogLevel(1) - - !---------------------------------------------- - !--- Clocks --- - !---------------------------------------------- - - call ESMF_Initialize(rc=rc) - Calendar = ESMF_CalendarCreate( name='clmdrv_NOLEAP', & - calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) - call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1, s=0, calendar=Calendar, rc=rc) - call ESMF_TimeSet(StopTime , yy=2000, mm=1, dd=10, s=0, calendar=Calendar, rc=rc) - call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) - EClock = ESMF_ClockCreate(name='clmdrv_EClock', & - TimeStep=TimeStep, startTime=StartTime, & - RefTime=StartTime, stopTime=stopTime, rc=rc) - - EAlarm_stop = ESMF_AlarmCreate(name='seq_timemgr_alarm_stop' , & - clock=EClock, ringTime=StopTime, rc=rc) - EAlarm_rest = ESMF_AlarmCreate(name='seq_timemgr_alarm_restart', & - clock=EClock, ringTime=StopTime, rc=rc) - - call ESMF_TimeGet( StartTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' StartTime ymds=',yy,mm,dd,sec - call ESMF_TimeGet( StopTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' StopTime ymds=',yy,mm,dd,sec - call shr_sys_flush(iunit) - - !---------------------------------------------- - !--- Coupling --- - !---------------------------------------------- - - !--- coupling fields - seq_flds_dom_coord='lat:lon' - seq_flds_dom_other='area:aream:mask:frac' - seq_flds_dom_fields=trim(seq_flds_dom_coord)//':'//trim(seq_flds_dom_other) - - seq_flds_x2l_states= 'Sa_z:Sa_u:Sa_v:Sa_tbot:Sa_ptem:Sa_shum:Sa_pbot:Sg_icemask:Sg_icemask_coupled_fluxes' - seq_flds_x2l_fluxes= 'Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl:Faxa_lwdn:Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf:Faxa_bcphidry:Faxa_bcphodry:Faxa_bcphiwet:Faxa_ocphidry:Faxa_ocphodry:Faxa_ocphiwet:Faxa_dstwet1:Faxa_dstwet2:Faxa_dstwet3:Faxa_dstwet4:Faxa_dstdry1:Faxa_dstdry2:Faxa_dstdry3:Faxa_dstdry4:Flrr_flood:Flrr_volr' - seq_flds_x2l_fields= trim(seq_flds_x2l_states)//':'//trim(seq_flds_x2l_fluxes) - - seq_flds_l2x_states= 'Sl_avsdr:Sl_anidr:Sl_avsdf:Sl_anidf:Sl_tref:Sl_qref:Sl_t:Sl_fv:Sl_ram1:Sl_snowh:Sl_u10' - seq_flds_l2x_fluxes= 'Fall_swnet:Fall_taux:Fall_tauy:Fall_lat:Fall_sen:Fall_lwup:Fall_evap:Fall_flxdst1:Fall_flxdst2:Fall_flxdst3:Fall_flxdst4:Flrl_rofl:Flrl_rofi:Fall_voc001:Fall_voc002:Fall_voc003:Fall_voc004:Fall_voc005:Fall_voc006:Fall_voc007:Fall_voc008' - seq_flds_l2x_fields= trim(seq_flds_l2x_states)//':'//trim(seq_flds_l2x_fluxes) - - !--- set orbital params - orb_iyear = 1990 - call shr_orb_params(orb_iyear, orb_eccen, orb_obliq, orb_mvelp, & - orb_obliqr, orb_lambm0, orb_mvelpp, .true.) - ! call seq_infodata_putData(infodata, orb_eccen=orb_eccen, orb_mvelpp=orb_mvelpp, & - ! orb_lambm0=orb_lambm0, orb_obliqr=orb_obliqr ) - - !--- set case information - case_name = 'clmdrv' - case_desc = 'clmdrv with clm' - model_version = 'clmdrv0.1' - hostname = 'undefined' - username = 'undefined' - start_type = 'startup' - brnch_retain_casename = .true. - single_column = .false. - scmlat = 0.0 - scmlon = 0.0 - atm_aero = .true. - call seq_infodata_putData(infodata, case_name=case_name, & - case_desc=case_desc, single_column=single_column, & - scmlat=scmlat, scmlon=scmlon, & - brnch_retain_casename=brnch_retain_casename, & - start_type=start_type, model_version=model_version, & - hostname=hostname, username=username, & - atm_aero=atm_aero ) - - !---------------------------------------------- - !--- lnd_init --- - !---------------------------------------------- - - write(iunit,*) subname,' calling lnd_init_mct' - call shr_sys_flush(iunit) - ! call lnd_init_mct(Eclock, cdata, x2l, l2x) - - call diag_avect(l2x,mpicom_clmdrv,'l2x_init') - - idx_Sa_z = mct_avect_indexra(x2l,'Sa_z') - idx_Sa_u = mct_avect_indexra(x2l,'Sa_u') - idx_Sa_v = mct_avect_indexra(x2l,'Sa_v') - idx_Sa_tbot = mct_avect_indexra(x2l,'Sa_tbot') - idx_Sa_ptem = mct_avect_indexra(x2l,'Sa_ptem') - idx_Sa_shum = mct_avect_indexra(x2l,'Sa_shum') - idx_Sa_pbot = mct_avect_indexra(x2l,'Sa_pbot') - idx_Faxa_rainc = mct_avect_indexra(x2l,'Faxa_rainc') - idx_Faxa_rainl = mct_avect_indexra(x2l,'Faxa_rainl') - idx_Faxa_snowc = mct_avect_indexra(x2l,'Faxa_snowc') - idx_Faxa_snowl = mct_avect_indexra(x2l,'Faxa_snowl') - idx_Faxa_lwdn = mct_avect_indexra(x2l,'Faxa_lwdn') - idx_Faxa_swndr = mct_avect_indexra(x2l,'Faxa_swndr') - idx_Faxa_swvdr = mct_avect_indexra(x2l,'Faxa_swvdr') - idx_Faxa_swndf = mct_avect_indexra(x2l,'Faxa_swndf') - idx_Faxa_swvdf = mct_avect_indexra(x2l,'Faxa_swvdf') - - !---------------------------------------------- - !--- atm and atm/lnd coupling init --- - !---------------------------------------------- - - ! read in the mesh - ! TODO: set cvalue to filepath of atm mesh - cvalue = "/path/to/foo" - - if (masterproc) then - write(iulog,*)'mesh file for domain is ',trim(cvalue) - end if - - EMesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - - - state = ESMF_StateCreate(name=statename, & - stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) - - ! Create Field Bundle - FBout = ESMF_FieldBundleCreate(name=trim(lname), rc=rc) - - ! Create individual states and add to field bundle - field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name="Sa_z", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! Add FB to state - call ESMF_StateAdd(state, (/FBout/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! fill in pointer with data - call ESMF_StateGet(State, itemName="Sa_z", field=lfield, rc=rc) - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) - - ! then - fldptr = 30.0 - - !---------------------------------------------- - !--- Time Loop --- - !---------------------------------------------- - - call ESMF_ClockGet(Eclock, currTime=CurrTime, rc=rc) - do while (CurrTime < StopTime) - call ESMF_ClockAdvance(EClock, rc=rc) - call ESMF_ClockGet(EClock, currTime=CurrTime, rc=rc) - call ESMF_TimeGet( CurrTime, yy=yy, mm=mm, dd=dd, s=sec, rc=rc ) - write(iunit,'(1x,2a,4i6)') subname,' clmdrv ymds=',yy,mm,dd,sec - call shr_sys_flush(iunit) - - ! can manually override the alarms as needed - call ESMF_AlarmRingerOff(EAlarm_rest, rc=rc) - if (mod(dd,5)==0 .and. sec==0) call ESMF_AlarmRingerOn(EAlarm_rest,rc) - - ! set the coupling data that is sent to the land model, this is on atm decomp - ! this is just sample test data - ! these all need to be set in the pointers - Sa_z = 30.0 ! m - Sa_u = 0.0 ! m/s - Sa_v = 0.0 ! m/s - Sa_tbot = 280.0 ! degK - Sa_ptem = 280.0 ! degK - Sa_shum = 0.0004 ! kg/kg - Sa_pbot = 100100.0 ! Pa - Faxa_rainc = 4.0e-8 ! kg/m2s - Faxa_rainl = 3.0e-8 ! kg/m2s - Faxa_snowc = 1.0e-8 ! kg/m2s - Faxa_snowl = 2.0e-8 ! kg/m2s - Faxa_lwdn = 200.0 ! W/m2 - Faxa_swndr = 100.0 ! W/m2 - Faxa_swvdr = 90.0 ! W/m2 - Faxa_swndf = 20.0 ! W/m2 - Faxa_swvdf = 40.0 ! W/m2 - - ! run clm - write(iunit,*) subname,' call lilac%run',yy,mm,dd,sec - call lilac%run(importState, exportState, clock) - ! call lnd_run_mct(Eclock, cdata, x2l, l2x) - - enddo - - !---------------------------------------------- - !--- lnd_final --- - !---------------------------------------------- - - write(iunit,*) subname,' calling lnd_final_mct' - call shr_sys_flush(iunit) - ! call lnd_final_mct(Eclock, cdata, x2l, l2x) - - !---------------------------------------------- - !--- Done --- - !---------------------------------------------- - - write(iunit,*) subname,' DONE' - call shr_sys_flush(iunit) - call MPI_Finalize(ierr) - - subroutine fldlist_add(num, fldlist, stdname) - integer, intent(inout) :: num - type(fld_list_type), intent(inout) :: fldlist(:) - character(len=*), intent(in) :: stdname - - - ! local variables - integer :: rc - integer :: dbrc - character(len=*), parameter :: subname='(dshr_nuopc_mod:fldlist_add)' - !------------------------------------------------------------------------------- - - - ! Set up a list of field information - - - num = num + 1 - if (num > fldsMax) then - call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - return - endif - fldlist(num)%stdname = trim(stdname) - - - end subroutine fldlist_add - -end PROGRAM lilac_data_driver - diff --git a/lilac/lilac/esmf_utils.f90 b/lilac/lilac/esmf_utils.f90 deleted file mode 100644 index 57f9cf0168..0000000000 --- a/lilac/lilac/esmf_utils.f90 +++ /dev/null @@ -1,221 +0,0 @@ -module esmf_utils - - ! Wrappers and derived types exposing ESMF components to LILAC - - -#include "ESMF.h" - use ESMF - - implicit none - private - - character(*), parameter :: modname = "(esmf_utils)" - - interface - subroutine userRoutine(gridcomp, rc) - use ESMF_CompMod - implicit none - type(ESMF_GridComp) :: gridcomp ! must not be optional - integer, intent(out) :: rc ! must not be optional - end subroutine userRoutine - end interface - - interface - subroutine userCplRoutine(cplcomp, rc) - use ESMF_CompMod - implicit none - type(ESMF_CplComp) :: cplcomp ! must not be optional - integer, intent(out) :: rc ! must not be optional - end subroutine userCplRoutine - end interface - - ! Consider renaming ESMFInfoType (add lilac to name) - type, public :: ESMFInfoType - private - character(len=ESMF_MAXSTR) :: name - - type(ESMF_VM) :: vm - type(ESMF_State) :: land_import - type(ESMF_State) :: land_export - type(ESMF_State) :: atmos_import - type(ESMF_State) :: atmos_export - type(ESMF_GridComp) :: atmos_comp - type(ESMF_GridComp) :: land_comp - type(ESMF_CplComp) :: cpl_comp - - contains - procedure, public :: init => init - procedure, public :: run => run - procedure, public :: final => final - - end type ESMFInfoType - -contains - - subroutine init(self, name, atmos_register, land_register, cpl_register) - implicit none - class(ESMFInfoType), intent(inout) :: self - character(len=ESMF_MAXSTR), intent(in) :: name - procedure(userRoutine) :: atmos_register - procedure(userRoutine) :: land_register - procedure(userCplRoutine) :: cpl_register - - ! Local variables - character(len=ESMF_MAXSTR) :: cname1, cname2, cplname - integer :: localPet, petCount, rc=ESMF_SUCCESS - - character(len=*), parameter :: subname=trim(modname)//':(init) ' - - call ESMF_LogWrite(subname//"esmf_info%init()", ESMF_LOGMSG_INFO) - - self%name = trim(name) - - ! Create section - !------------------------------------------------------------------------- - - ! Initialize framework and get back default global VM - - ! only run if not esmf_isintialized() - call ESMF_Initialize(vm=self%vm, defaultlogfilename="lilac.log", logkindflag=ESMF_LOGKIND_MULTI, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - ! Get number of PETs we are running with - call ESMF_VMGet(self%vm, petCount=petCount, localPet=localPet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - ! Create the 2 model components and a coupler - cname1 = "land" - ! use petList to define land on all PET - self%land_comp = ESMF_GridCompCreate(name=cname1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(cname1)//" component", ESMF_LOGMSG_INFO) - - cname2 = "atmosphere" - ! use petList to define atmosphere on all PET - self%atmos_comp = ESMF_GridCompCreate(name=cname2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(cname2)//" component", ESMF_LOGMSG_INFO) - - cplname = "lilac coupler" - ! no petList means that coupler component runs on all PETs - self%cpl_comp = ESMF_CplCompCreate(name=cplname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Created "//trim(cplname)//" component", ESMF_LOGMSG_INFO) - - call ESMF_LogWrite(subname//"Comp Creates finished", ESMF_LOGMSG_INFO) - - ! Register section - !------------------------------------------------------------------------- - call ESMF_GridCompSetServices(self%atmos_comp, userRoutine=atmos_register, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"atmos SetServices finished", ESMF_LOGMSG_INFO) - - call ESMF_GridCompSetServices(self%land_comp, userRoutine=land_register, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"land SetServices finished", ESMF_LOGMSG_INFO) - - call ESMF_CplCompSetServices(self%cpl_comp, userRoutine=cpl_register, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Cpl SetServices finished", ESMF_LOGMSG_INFO) - - ! Init section - !------------------------------------------------------------------------- - ! land import/export states - self%land_import = ESMF_StateCreate(name="land import", stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - self%land_export = ESMF_StateCreate(name="land export", stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompInitialize(self%land_comp, importState=self%land_import, exportState=self%land_export, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Land Initialize finished", ESMF_LOGMSG_INFO) - - ! atmosphere import/export state - self%atmos_import = ESMF_StateCreate(name="atmos import", stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - self%atmos_export = ESMF_StateCreate(name="atmos export", stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompInitialize(self%atmos_comp, exportState=self%atmos_export, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Atmosphere Initialize finished", ESMF_LOGMSG_INFO) - - ! call ESMF_CPLCompInitialize twice (once for each grid comp) - - end subroutine init - - subroutine run(self) - implicit none - class(ESMFInfoType), intent(inout) :: self - integer :: rc=ESMF_SUCCESS - character(len=*), parameter :: subname=trim(modname)//':(run) ' - - call ESMF_LogWrite(subname//"esmf_info%run()", ESMF_LOGMSG_INFO) - - ! TODO: need some help on order of imports/exports/runs and whether the land/atm both need import/export states - - ! atmosphere run - ! copy the atmos state and put it into atmos export - call ESMF_GridCompRun(self%atmos_comp, exportState=self%atmos_export, phase=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Atmosphere Run returned", ESMF_LOGMSG_INFO) - - ! coupler run - call ESMF_CplCompRun(self%cpl_comp, importState=self%atmos_export, exportState=self%land_import, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Coupler Run returned", ESMF_LOGMSG_INFO) - - ! land run - call ESMF_GridCompRun(self%land_comp, importState=self%land_import, exportState=self%land_export, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Land Run returned", ESMF_LOGMSG_INFO) - - ! coupler run - call ESMF_CplCompRun(self%cpl_comp, importState=self%land_export, exportState=self%atmos_import, rc=rc) - call ESMF_LogWrite(subname//"Coupler Run returned", ESMF_LOGMSG_INFO) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompRun(self%atmos_comp, importState=self%atmos_import, phase=2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(subname//"Atmosphere Run returned", ESMF_LOGMSG_INFO) - - end subroutine run - - subroutine final(self) - implicit none - class(ESMFInfoType), intent(inout) :: self - integer :: rc=ESMF_SUCCESS - character(len=*), parameter :: subname=trim(modname)//':(final) ' - - call ESMF_LogWrite(subname//"esmf_info%final()", ESMF_LOGMSG_INFO) - - ! Destroy section - call ESMF_GridCompDestroy(self%atmos_comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_GridCompDestroy(self%land_comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_CplCompDestroy(self%cpl_comp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_StateDestroy(self%land_export, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_StateDestroy(self%land_import, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_StateDestroy(self%atmos_export, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_StateDestroy(self%atmos_import, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out - - call ESMF_LogWrite(subname//"All Destroy routines done", ESMF_LOGMSG_INFO) - - end subroutine final - -end module esmf_utils diff --git a/lilac/lilac/lilac_mod.F90 b/lilac/lilac/lilac_mod.F90 new file mode 100644 index 0000000000..1e53604cb6 --- /dev/null +++ b/lilac/lilac/lilac_mod.F90 @@ -0,0 +1,614 @@ +module lilac_mod + + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + + ! !USES + use ESMF + use lilac_utils , only : fld_list_type, fldsMax, create_fldlists + use lilac_utils , only : atm2lnd_data1d_type , lnd2atm_data1d_type + use lilac_utils , only : atm2lnd_data2d_type , lnd2atm_data2d_type + use atmos_cap , only : atmos_register + !use lnd_shr_methods + use lnd_comp_esmf , only : lnd_register + use cpl_mod , only : cpl_atm2lnd_register , cpl_lnd2atm_register + + use mpi , only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_SUCCESS + use shr_pio_mod , only : shr_pio_init1, shr_pio_init2 + + use clm_varctl , only : iulog + use spmdMod , only : masterproc + implicit none + + !TODO (NS,2019-08-07): + ! We will move this later to lnd_cap (ctsm_cap) and atmos_cap + !use atmos_cap , only : a2l_fldnum + integer , public , parameter :: a2l_fldnum = 17 + integer , public , parameter :: l2a_fldnum = 12 + + public :: lilac_init + public :: lilac_run + + character(*) , parameter :: modname = "lilac_mod" + !type(fld_list_type), public :: a2c_fldlist, c2a_fldlist !defined in atmosphere and land caps.... + + !------------------------------------------------------------------------ + ! !Clock, TimeInterval, and Times + type(ESMF_Clock) :: clock + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Time) :: startTime + type(ESMF_Time) :: stopTime + type(ESMF_Alarm) :: EAlarm_stop, EAlarm_rest + type(ESMF_Calendar),target :: calendar + integer :: yy,mm,dd,sec + ! ! Gridded Components and Coupling Components + type(ESMF_GridComp) :: atmos_gcomp + type(ESMF_GridComp) :: land_gcomp + type(ESMF_CplComp) :: cpl_atm2lnd_comp + type(ESMF_CplComp) :: cpl_lnd2atm_comp + type(ESMF_State) :: atm2lnd_l_state , atm2lnd_a_state + type(ESMF_State) :: lnd2atm_a_state, lnd2atm_l_state + + !======================================================================== + contains + !======================================================================== + + subroutine lilac_init( atm2lnd1d, atm2lnd2d, lnd2atm1d, lnd2atm2d, gindex_atm) + + use atmos_cap , only : a2c_fldlist , c2a_fldlist + use atmos_cap , only : dummy_gindex_atm + use lnd_cap , only : l2c_fldlist , c2l_fldlist + + character(len=*), parameter :: subname=trim(modname)//': [lilac_init] ' + + ! input/output variables + type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d + type(atm2lnd_data2d_type), intent(in), optional :: atm2lnd2d + type(lnd2atm_data1d_type), intent(in), optional :: lnd2atm1d + type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d + + integer , allocatable :: gindex_atm(:) + ! local variables + + type(ESMF_State) :: importState, exportState + + !character(len=*) :: atm_mesh_filepath !!! For now this is hardcoded in the atmos init + + integer :: rc , userRC + character(len=ESMF_MAXSTR) :: gcname1 , gcname2 ! Gridded components names + character(len=ESMF_MAXSTR) :: ccname1 , ccname2 ! Coupling components names + + + ! Namelist and related variables + integer :: fileunit + integer :: i_max, j_max + real(ESMF_KIND_R8) :: x_min, x_max, y_min, y_max + integer :: s_month, s_day, s_hour, s_min + integer :: e_month, e_day, e_hour, e_min + namelist /input/ i_max, j_max, x_min, x_max, y_min, y_max, & + s_month, s_day, s_hour, s_min, & + e_month, e_day, e_hour, e_min + + + integer :: COMP_COMM + integer :: ierr + integer :: ntasks,mytask ! mpicom size and rank + integer :: ncomps = 1 ! land only + integer :: n + integer :: i + integer, parameter :: debug = 1 !-- internal debug level + !!! above: https://github.com/yudong-tian/LIS-CLM4.5SP/blob/8cec515a628325c73058cfa466db63210cd562ac/pio-xlis-bld/xlis_main.F90 + + + character(len=128) :: fldname + integer, parameter :: begc = 1 !-- internal debug level + integer, parameter :: endc = 3312/4/2/2 !-- internal debug level + character(*),parameter :: F02 = "('[lilac_mod]',a,i5,2x,d26.19)" + !------------------------------------------------------------------------ + ! Initialize return code + rc = ESMF_SUCCESS + + if (masterproc) then + print *, "---------------------------------------" + print *, " Lilac Demo Application Start " + print *, "---------------------------------------" + end if + + !----------------------------------------------------------------------------- + ! Initiallize MPI + !----------------------------------------------------------------------------- + + ! this is coming from + ! /glade/work/mvertens/ctsm.nuopc/cime/src/drivers/nuopc/drivers/cime/esmApp.F90 + COMP_COMM = MPI_COMM_WORLD + + !https://github.com/yudong-tian/LIS-CLM4.5SP/blob/8cec515a628325c73058cfa466db63210cd562ac/xlis-bld/xlis_main.F90 + !if (ierr .ne. MPI_SUCCESS) then + ! print *,'Error starting MPI program. Terminating.' + ! call MPI_ABORT(MPI_COMM_WORLD, ierr) + !end if + + ! + + call MPI_COMM_RANK(COMP_COMM, mytask, ierr) + call MPI_COMM_SIZE(COMP_COMM, ntasks, ierr) + + if (masterproc) then + print *, "MPI initialization done ..., ntasks=", ntasks + end if + + !----------------------------------------------------------------------------- + ! Initialize PIO + !----------------------------------------------------------------------------- + + ! this is coming from + ! /glade/work/mvertens/ctsm.nuopc/cime/src/drivers/nuopc/drivers/cime/esmApp.F90 + ! with call shr_pio_init1(8, "drv_in", COMP_COMM) + + ! For planned future use of async io using pio2. The IO tasks are seperated from the compute tasks here + ! and COMP_COMM will be MPI_COMM_NULL on the IO tasks which then call shr_pio_init2 and do not return until + ! the model completes. All other tasks call ESMF_Initialize. 8 is the maximum number of component models + ! supported + + call shr_pio_init1(ncomps, "drv_in", COMP_COMM) + ! NS Question: How many should ncomps (above 1) be?????? + + if (COMP_COMM .eq. MPI_COMM_NULL) then + !call shr_pio_init2( + call mpi_finalize(ierror=rc) + stop + endif + + !------------------------------------------------------------------------- + ! Initialize ESMF, set the default calendar and log type. + !------------------------------------------------------------------------- + call ESMF_Initialize(defaultCalKind=ESMF_CALKIND_GREGORIAN,logappendflag=.false., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogSet(flush=.true.) + call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"Initializing ESMF ", ESMF_LOGMSG_INFO) + + !------------------------------------------------------------------------- + ! Read in configuration data -- namelist.input from host atmosphere(wrf) + !------------------------------------------------------------------------- + ! Read in namelist file ... + call ESMF_UtilIOUnitGet(unit=fileunit, rc=rc) ! get an available Fortran unit number + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + if (masterproc) then + print *, "---------------------------------------" + end if + + open(fileunit, status="old", file="namelist_lilac", action="read", iostat=rc) + + if (rc .ne. 0) then + call ESMF_LogSetError(rcToCheck=ESMF_RC_FILE_OPEN, msg="Failed to open namelist file 'namelist'", line=__LINE__, file=__FILE__) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + endif + read(fileunit, input) + continue + close(fileunit) + + !------------------------------------------------------------------------- + ! Create Field lists -- Basically create a list of fields and add a default + ! value to them. + !------------------------------------------------------------------------- + + !------------------------------------------------------------------------- + ! !---- from atm ----! a2c_fldlist & c2l_fldlist + !------------------------------------------------------------------------- + !allocate (a2c_fldlist(a2l_fldnum)) + !allocate (c2l_fldlist(a2l_fldnum)) + + !------------------------------------------------------------------------- + ! !---- from land ----! l2c_fldlist & c2a_fldlist + !------------------------------------------------------------------------- + !allocate (c2a_fldlist(l2a_fldnum)) + !allocate (l2c_fldlist(l2a_fldnum)) + + allocate (a2c_fldlist(fldsMax)) + allocate (c2a_fldlist(fldsMax)) + + allocate (l2c_fldlist(fldsmax)) + allocate (c2l_fldlist(fldsmax)) + + if (masterproc) then + print *, "creating empty field lists !" + end if + + call ESMF_LogWrite(subname//"fielldlists are allocated!", ESMF_LOGMSG_INFO) + + ! create field lists + call create_fldlists(a2c_fldlist, c2a_fldlist,l2c_fldlist, c2l_fldlist) + call ESMF_LogWrite(subname//"fielldlists are created!", ESMF_LOGMSG_INFO) + + !------------------------------------------------------------------------- + ! !---- from atm ----! a2c_fldlist filling the arrayptr.. + !------------------------------------------------------------------------- + + + ! FIXME: This should go to the demo_driver or real atmosphere...... + !allocate( a2c_fldlist(fldsmax)%farrayptr1d(1728)) + !do n = 1,a2l_fldnum + ! print *, " index is ", n + ! a2c_fldlist(1)%farrayptr1d(:) = 300.0 + !end do + + a2c_fldlist(1)%farrayptr1d => atm2lnd1d%Sa_z + a2c_fldlist(2)%farrayptr1d => atm2lnd1d%Sa_topo + + !if (masterproc .and. debug > 0) then + fldname = 'Sa_topo' + do i=begc, endc + write (iulog,F02)'import: nstep, n, '//trim(fldname)//' = ',i, a2c_fldlist(2)%farrayptr1d(i) + end do + !end if + a2c_fldlist(3)%farrayptr1d => atm2lnd1d%Sa_u + a2c_fldlist(4)%farrayptr1d => atm2lnd1d%Sa_v + a2c_fldlist(5)%farrayptr1d => atm2lnd1d%Sa_ptem + a2c_fldlist(6)%farrayptr1d => atm2lnd1d%Sa_pbot + a2c_fldlist(7)%farrayptr1d => atm2lnd1d%Sa_tbot + a2c_fldlist(8)%farrayptr1d => atm2lnd1d%Sa_shum + + a2c_fldlist(9)%farrayptr1d => atm2lnd1d%Faxa_lwdn + a2c_fldlist(10)%farrayptr1d => atm2lnd1d%Faxa_rainc + a2c_fldlist(11)%farrayptr1d => atm2lnd1d%Faxa_rainl + a2c_fldlist(12)%farrayptr1d => atm2lnd1d%Faxa_snowc + a2c_fldlist(13)%farrayptr1d => atm2lnd1d%Faxa_snowl + + a2c_fldlist(14)%farrayptr1d => atm2lnd1d%Faxa_swndr + a2c_fldlist(15)%farrayptr1d => atm2lnd1d%Faxa_swvdr + a2c_fldlist(16)%farrayptr1d => atm2lnd1d%Faxa_swndf + a2c_fldlist(17)%farrayptr1d => atm2lnd1d%Faxa_swvdf + !------------------------------------------------------------------------- + + ! should I point to zero??? + + c2a_fldlist(1)%farrayptr1d => lnd2atm1d%Sl_lfrin + c2a_fldlist(2)%farrayptr1d => lnd2atm1d%Sl_t + c2a_fldlist(3)%farrayptr1d => lnd2atm1d%Sl_tref + c2a_fldlist(4)%farrayptr1d => lnd2atm1d%Sl_qref + c2a_fldlist(5)%farrayptr1d => lnd2atm1d%Sl_avsdr + c2a_fldlist(6)%farrayptr1d => lnd2atm1d%Sl_anidr + c2a_fldlist(7)%farrayptr1d => lnd2atm1d%Sl_avsdf + c2a_fldlist(8)%farrayptr1d => lnd2atm1d%Sl_anidf + + c2a_fldlist(9)%farrayptr1d => lnd2atm1d%Sl_snowh + c2a_fldlist(10)%farrayptr1d => lnd2atm1d%Sl_u10 + c2a_fldlist(11)%farrayptr1d => lnd2atm1d%Sl_fv + c2a_fldlist(12)%farrayptr1d => lnd2atm1d%Sl_ram1 + + + + dummy_gindex_atm = gindex_atm + ! ======================================================================== + + !------------------------------------------------------------------------- + ! Create Gridded Component! -- atmosphere ( atmos_cap) + !------------------------------------------------------------------------- + gcname1 = " Atmosphere or Atmosphere Cap" + atmos_gcomp = ESMF_GridCompCreate(name=gcname1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Created "//trim(gcname1)//" component", ESMF_LOGMSG_INFO) + print *, "Atmosphere Gridded Component Created!" + + !------------------------------------------------------------------------- + ! Create Gridded Component! --- CTSM land ( land_capX ) + !------------------------------------------------------------------------- + gcname2 = " Land ctsm " + land_gcomp = ESMF_GridCompCreate(name=gcname2, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Created "//trim(gcname2)//" component", ESMF_LOGMSG_INFO) + print *, " Land (ctsm) Gridded Component Created!" + + !------------------------------------------------------------------------- + ! Create Coupling Component! --- Coupler from atmos to land + !------------------------------------------------------------------------- + ccname1 = "Coupler from atmosphere to land" + cpl_atm2lnd_comp = ESMF_CplCompCreate(name=ccname1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Created "//trim(ccname1)//" component", ESMF_LOGMSG_INFO) + print *, "1st Coupler Component (atmosphere to land ) Created!" + + !------------------------------------------------------------------------- + ! Create Coupling Component! -- Coupler from land to atmos + !------------------------------------------------------------------------- + ccname2 = "Coupler from land to atmosphere" + cpl_lnd2atm_comp = ESMF_CplCompCreate(name=ccname2, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Created "//trim(ccname2)//" component", ESMF_LOGMSG_INFO) + print *, "2nd Coupler Component (land to atmosphere) Created!" + + ! ======================================================================== + + !------------------------------------------------------------------------- + ! Register section -- set services -- atmos_cap + !------------------------------------------------------------------------- + call ESMF_GridCompSetServices(atmos_gcomp, userRoutine=atmos_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//" atmos SetServices finished!", ESMF_LOGMSG_INFO) + print *, " Atmosphere Gridded Component SetServices finished!" + !------------------------------------------------------------------------- + ! Register section -- set services -- land cap + !------------------------------------------------------------------------- + call ESMF_GridCompSetServices(land_gcomp, userRoutine=lnd_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"land SetServices finished!", ESMF_LOGMSG_INFO) + print *, "Land Gridded Component SetServices finished!" + !------------------------------------------------------------------------- + ! Register section -- set services -- coupler atmosphere to land + !------------------------------------------------------------------------- + call ESMF_CplCompSetServices(cpl_atm2lnd_comp, userRoutine=cpl_atm2lnd_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Coupler from atmosphere to land SetServices finished!", ESMF_LOGMSG_INFO) + print *, "Coupler from atmosphere to land SetServices finished!" + !------------------------------------------------------------------------- + ! Register section -- set services -- coupler land to atmosphere + !------------------------------------------------------------------------- + call ESMF_CplCompSetServices(cpl_lnd2atm_comp, userRoutine=cpl_lnd2atm_register, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Coupler from land to atmosphere SetServices finished!", ESMF_LOGMSG_INFO) + print *, "Coupler from land to atmosphere SetServices finished!" + + ! ======================================================================== + + !------------------------------------------------------------------------- + ! Create and initialize a clock! + ! Clock is initialized here from namelist.input from WRF..... still we + ! are looping over time from host atmosphere + !------------------------------------------------------------------------- + calendar = ESMF_CalendarCreate(name='lilac_drv_NOLEAP', calkindflag=ESMF_CALKIND_NOLEAP, rc=rc ) + call ESMF_TimeIntervalSet(TimeStep, s=2, rc=rc) ! time step every 2second + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + !call ESMF_TimeSet(startTime, yy=2003, mm=s_month, dd=s_day, h=s_hour, m=s_min, s=0, rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !call ESMF_TimeSet(stopTime, yy=2003, mm=e_month, dd=e_day, h=e_hour, m=e_min, s=0, rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !clock = ESMF_ClockCreate(timeStep=timeStep, startTime=startTime, stopTime=stopTime, rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_TimeSet(StartTime, yy=2000, mm=1, dd=1 , s=0, calendar=Calendar, rc=rc) + call ESMF_TimeSet(StopTime , yy=2000, mm=03, dd=01, s=0, calendar=Calendar, rc=rc) + !call ESMF_TimeIntervalSet(TimeStep, s=3600, rc=rc) + call ESMF_TimeIntervalSet(TimeStep, s=1800, rc=rc) + clock = ESMF_ClockCreate(name='lilac_drv_EClock', TimeStep=TimeStep, startTime=StartTime, RefTime=StartTime, stopTime=stopTime, rc=rc) + + print *, "---------------------------------------" + !call ESMF_ClockPrint (clock, rc=rc) + print *, "=======================================" + !call ESMF_CalendarPrint ( calendar , rc=rc) + print *, "---------------------------------------" + + ! ======================================================================== + + !------------------------------------------------------------------------- + ! Create the necessary import and export states used to pass data + ! between components. + !------------------------------------------------------------------------- + + ! following 4 states are lilac module variables: + ! 1- atm2lnd_a_state 2- atm2lnd_l_state 3- lnd2atm_a_state 4-lnd2atm_l_state + + atm2lnd_a_state = ESMF_StateCreate(name=gcname1, stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + atm2lnd_l_state = ESMF_StateCreate(name=gcname1, stateintent=ESMF_STATEINTENT_EXPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + lnd2atm_a_state = ESMF_StateCreate(name=gcname2, stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + lnd2atm_l_state = ESMF_StateCreate(name=gcname2, stateintent=ESMF_STATEINTENT_IMPORT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_LogWrite(subname//"Empty import and export states are created!!", ESMF_LOGMSG_INFO) + print *, "Empty import and export states are created!!" + + ! returns a valid state_to_lnd_atm and an empty state_from_land_atmgrid + + ! ------------------------------------------------------------------------- + ! Grid Componenet Initialization -- 1- atmos cap 2- lnd cap ! + ! 3- cpl_atm2lnd 4- cpl_lnd2atm ! + ! ------------------------------------------------------------------------- + + call ESMF_GridCompInitialize(atmos_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"atmos_cap or atmos_gcomp initialized", ESMF_LOGMSG_INFO) + + call ESMF_GridCompInitialize(land_gcomp , importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"lnd_cap or land_gcomp initialized", ESMF_LOGMSG_INFO) + + ! All 4 states that are module variables are no longer empty - have been initialized + + call ESMF_CplCompInitialize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"coupler :: cpl_atm2lnd_comp initialized", ESMF_LOGMSG_INFO) + print *, "coupler :: cpl_atm2lnd_comp initialize finished" !, rc =", rc + + call ESMF_CplCompInitialize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"coupler :: cpl_lnd2atm_comp initialized", ESMF_LOGMSG_INFO) + print *, "coupler :: cpl_lnd2atm_comp initialize finished" !, rc =", rc + + end subroutine lilac_init + + !======================================================================== + + subroutine lilac_run( ) + + use atmos_cap, only : a2c_fldlist, c2a_fldlist + use lnd_cap, only : l2c_fldlist, c2l_fldlist + + character(len=*), parameter :: subname=trim(modname)//': [lilac_run] ' + type(ESMF_State) :: importState, exportState + + ! local variables + integer :: rc, userRC + character(len=ESMF_MAXSTR) :: gcname1, gcname2 ! Gridded components names + character(len=ESMF_MAXSTR) :: ccname1, ccname2 ! Coupling components names + !integer, parameter :: fldsMax = 100 + + ! input/output variables + !type(atm2lnd_data1d_type), intent(in), optional :: atm2lnd1d + !type(atm2lnd_data2d_type), intent(in), optional :: atm2lnd2d + !type(lnd2atm_data1d_type), intent(in), optional :: lnd2atm1d + !type(lnd2atm_data2d_type), intent(in), optional :: lnd2atm2d + + type (ESMF_Clock) :: local_clock + + !------------------------------------------------------------------------ + ! Initialize return code + rc = ESMF_SUCCESS + + print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + print *, " Lilac Run " + print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + + !------------------------------------------------------------------------- + ! Create a local clock from the general clock! + !------------------------------------------------------------------------- + + local_clock = ESMF_ClockCreate(clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + print *, "Run Loop Start time" + !call ESMF_ClockPrint(local_clock, options="currtime string", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + !------------------------------------------------------------------------- + ! We are running components in this order: + ! 1- atmos_cap 2- cpl_atm2lnd + ! 3- lnd_cap 4- cpl_lnd2atm + !------------------------------------------------------------------------- + ! lilac run the RunComponent phase in a time loop + + !!! if we want to loop through clock in atmos cap. + !do while (.NOT. ESMF_ClockIsStopTime(local_clock, rc=rc)) + call ESMF_GridCompRun(atmos_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=local_clock, rc=rc, userRC=userRC) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=userRC, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"atmos_cap or atmos_gcomp is running", ESMF_LOGMSG_INFO) + print *, "Running atmos_cap gridded component , rc =", rc + + call ESMF_CplCompRun(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=local_clock, rc=rc , userRC=userRC) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=userRC, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) + print *, "Running coupler component..... cpl_atm2lnd_comp , rc =", rc + + call ESMF_GridCompRun(land_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=local_clock, rc=rc, userRC=userRC) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=userRC, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"lnd_cap or land_gcomp is running", ESMF_LOGMSG_INFO) + print *, "Running lnd_cap gridded component , rc =", rc + + call ESMF_CplCompRun(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=local_clock, rc=rc, userRC=userRC) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=userRC, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) + print *, "Running coupler component..... cpl_lnd2atm_comp , rc =", rc + + ! Advance the time + call ESMF_ClockAdvance(local_clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"time is icremented now... (ClockAdvance)", ESMF_LOGMSG_INFO) + print *, "time is icremented now... (ClockAdvance) , rc =", rc + + !end do + + end subroutine lilac_run + + + subroutine lilac_final( ) + + use atmos_cap, only : a2c_fldlist, c2a_fldlist + use lnd_cap, only : l2c_fldlist, c2l_fldlist + + + character(len=*), parameter :: subname=trim(modname)//': [lilac_final] ' + type(ESMF_State) :: importState, exportState + + ! local variables + integer :: rc, userRC + character(len=ESMF_MAXSTR) :: gcname1, gcname2 ! Gridded components names + character(len=ESMF_MAXSTR) :: ccname1, ccname2 ! Coupling components names + !integer, parameter :: fldsMax = 100 + + !------------------------------------------------------------------------ + !------------------------------------------------------------------------ + ! Initialize return code + rc = ESMF_SUCCESS + + print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + print *, " Lilac Finalizing " + print *, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + !------------------------------------------------------------------------- + ! Gridded Component Finalizing! --- atmosphere + !------------------------------------------------------------------------- + call ESMF_GridCompFinalize(atmos_gcomp, importState=lnd2atm_a_state, exportState=atm2lnd_a_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"atmos_cap or atmos_gcomp is running", ESMF_LOGMSG_INFO) + print *, "Finalizing atmos_cap gridded component , rc =", rc + + !------------------------------------------------------------------------- + ! Coupler component Finalizing --- coupler atmos to land + !------------------------------------------------------------------------- + call ESMF_CplCompFinalize(cpl_atm2lnd_comp, importState=atm2lnd_a_state, exportState=atm2lnd_l_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"running cpl_atm2lnd_comp ", ESMF_LOGMSG_INFO) + print *, "Finalizing coupler component..... cpl_atm2lnd_comp , rc =", rc + + !------------------------------------------------------------------------- + ! Gridded Component Finalizing! --- land + !------------------------------------------------------------------------- + call ESMF_GridCompFinalize(land_gcomp, importState=atm2lnd_l_state, exportState=lnd2atm_l_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"lnd_cap or land_gcomp is running", ESMF_LOGMSG_INFO) + print *, "Finalizing lnd_cap gridded component , rc =", rc + + !------------------------------------------------------------------------- + ! Coupler component Finalizing --- coupler land to atmos + !------------------------------------------------------------------------- + call ESMF_CplCompFinalize(cpl_lnd2atm_comp, importState=lnd2atm_l_state, exportState=lnd2atm_a_state, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"running cpl_lnd2atm_comp ", ESMF_LOGMSG_INFO) + print *, "Finalizing coupler component..... cpl_lnd2atm_comp , rc =", rc + + + ! Then clean them up + call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"destroying all states ", ESMF_LOGMSG_INFO) + + print *, "ready to destroy all states" + call ESMF_StateDestroy(atm2lnd_a_state , rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_StateDestroy(atm2lnd_l_state, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_StateDestroy(lnd2atm_a_state, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_StateDestroy(lnd2atm_l_state, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_LogWrite(subname//"destroying all components ", ESMF_LOGMSG_INFO) + print *, "ready to destroy all components" + + call ESMF_GridCompDestroy(atmos_gcomp, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_GridCompDestroy(land_gcomp, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_CplCompDestroy(cpl_atm2lnd_comp, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + call ESMF_CplCompDestroy(cpl_lnd2atm_comp, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) + + call ESMF_LogWrite(subname//".........................", ESMF_LOGMSG_INFO) + print *, "end of Lilac Finalization routine" + + end subroutine lilac_final + + + + end module lilac_mod + diff --git a/lilac/lilac/lilac_utils.F90 b/lilac/lilac/lilac_utils.F90 new file mode 100644 index 0000000000..ef1074a909 --- /dev/null +++ b/lilac/lilac/lilac_utils.F90 @@ -0,0 +1,443 @@ +module lilac_utils + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! + !!! NS: THIS IS FROM JH WORK + + use ESMF + + implicit none + + public fldlist_add , create_fldlists + + integer, parameter :: fldsMax = 100 + + character(*) , parameter :: modname = "lilac_utils" + ! !PUBLIC TYPES: + type :: fld_list_type + character(len=128) :: stdname + real*8 :: default_value + character(len=128) :: units + real(ESMF_KIND_R8), pointer :: farrayptr1d(:) ! this will be filled in by lilac when it gets its data from the host atm + real(ESMF_KIND_R8), pointer :: farrayptr2d(:,:) ! this will be filled in by lilac when it gets its data from the host atm + integer :: ungridded_lbound = 0 + integer :: ungridded_ubound = 0 + end type fld_list_type + + !!! 1d for when we have mesh and 2d for when we have grids.... + type , public :: atm2lnd_data1d_type + real*8, pointer :: Sa_z (:) + real*8, pointer :: Sa_topo (:) + real*8, pointer :: Sa_u (:) + real*8, pointer :: Sa_v (:) + real*8, pointer :: Sa_ptem (:) + real*8, pointer :: Sa_pbot (:) + real*8, pointer :: Sa_tbot (:) + real*8, pointer :: Sa_shum (:) + real*8, pointer :: Sa_methane (:) + ! from atm - fluxes + real*8, pointer :: Faxa_lwdn (:) + real*8, pointer :: Faxa_rainc (:) + real*8, pointer :: Faxa_rainl (:) + real*8, pointer :: Faxa_snowc (:) + real*8, pointer :: Faxa_snowl (:) + real*8, pointer :: Faxa_swndr (:) + real*8, pointer :: Faxa_swvdr (:) + real*8, pointer :: Faxa_swndf (:) + real*8, pointer :: Faxa_swvdf (:) + + real*8, pointer :: Faxa_bcph (:) + end type atm2lnd_data1d_type + +! + + type , public :: atm2lnd_data2d_type + real*8, pointer :: Sa_z (:,:) + real*8, pointer :: Sa_topo (:,:) + real*8, pointer :: Sa_u (:,:) + real*8, pointer :: Sa_v (:,:) + real*8, pointer :: Sa_ptem (:,:) + real*8, pointer :: Sa_pbot (:,:) + real*8, pointer :: Sa_tbot (:,:) + real*8, pointer :: Sa_shum (:,:) + !real*8, pointer :: Sa_methane (:,:) + ! from atm - fluxes + real*8, pointer :: Faxa_lwdn (:,:) + real*8, pointer :: Faxa_rainc (:,:) + real*8, pointer :: Faxa_rainl (:,:) + real*8, pointer :: Faxa_snowc (:,:) + real*8, pointer :: Faxa_snowl (:,:) + real*8, pointer :: Faxa_swndr (:,:) + real*8, pointer :: Faxa_swvdr (:,:) + real*8, pointer :: Faxa_swndf (:,:) + real*8, pointer :: Faxa_swvdf (:,:) + end type atm2lnd_data2d_type + + + + + !type :: atm2lnd_data1d_type + ! real*8, pointer :: uwind (:) + ! real*8, pointer :: vwind (:) + ! real*8, pointer :: tbot (:) + !end type atm2lnd_data1d_type + + type :: lnd2atm_data1d_type + real*8, pointer :: Sl_lfrin (:) + real*8, pointer :: Sl_t (:) + real*8, pointer :: Sl_tref (:) + real*8, pointer :: Sl_qref (:) + real*8, pointer :: Sl_avsdr (:) + real*8, pointer :: Sl_anidr (:) + real*8, pointer :: Sl_avsdf (:) + real*8, pointer :: Sl_anidf (:) + real*8, pointer :: Sl_snowh (:) + real*8, pointer :: Sl_u10 (:) + real*8, pointer :: Sl_fv (:) + real*8, pointer :: Sl_ram1 (:) + end type lnd2atm_data1d_type + + !type :: atm2lnd_data2d_type + ! real*8, pointer :: uwind (:,:) + ! real*8, pointer :: vwind (:,:) + ! real*8, pointer :: tbot (:,:) + !end type atm2lnd_data2d_type + + type :: lnd2atm_data2d_type + real*8, pointer :: lwup (:,:) + real*8, pointer :: taux (:,:) + real*8, pointer :: tauy (:,:) + end type lnd2atm_data2d_type + + type :: this_clock + integer, pointer :: yy + integer, pointer :: mm + integer, pointer :: dd + integer, pointer :: hh + integer, pointer :: mn + integer, pointer :: ss + end type this_clock + !=============================================================================== + contains + !=============================================================================== + + subroutine fldlist_add(num, fldlist, stdname, default_value, units, ungridded_lbound, ungridded_ubound) + ! This adds a field to a fieldlist! + ! input/output variables + integer, intent(inout) :: num + type(fld_list_type), intent(inout) :: fldlist(:) + character(len=*), intent(in) :: stdname + real, optional, intent(in) :: default_value + character(len=*), optional, intent(in) :: units + integer, optional, intent(in) :: ungridded_lbound + integer, optional, intent(in) :: ungridded_ubound + + ! local variables + integer :: rc + character(len=*), parameter :: subname=trim(modname)//':[fldlist_add]' + !------------------------------------------------------------------------------- + call ESMF_LogWrite(subname//"inside fldlist_add!", ESMF_LOGMSG_INFO) + + ! Set up a list of field information + num = num + 1 + if (num > fldsMax) then + call ESMF_LogWrite(subname//"?!", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) + return + endif + + fldlist(num)%stdname = trim(stdname) + + if (present(ungridded_lbound) .and. present(ungridded_ubound)) then + fldlist(num)%ungridded_lbound = ungridded_lbound + fldlist(num)%ungridded_ubound = ungridded_ubound + end if + + if(present(default_value)) then + fldlist(num)%default_value = default_value + else + fldlist(num)%default_value = 0. + end if + if(present(units)) then + fldlist(num)%units = trim(units) + else + fldlist(num)%units = "" + end if + + !allocate (fldlist%farrayptr1d(fldsMax)) + + !fldlist%farrayptr1d = default_value + + end subroutine fldlist_add + + !subroutine create_fldlists(a2c_fldlist, c2l_fldlist, l2c_fldlist, c2a_fldlist, rof_prognostic, glc_present ) + subroutine create_fldlists(a2c_fldlist, c2l_fldlist, l2c_fldlist, c2a_fldlist) + + ! add all the necessary fields one by one to the fieldlist + type(fld_list_type), intent(inout) :: a2c_fldlist(fldsMax) + type(fld_list_type), intent(inout) :: c2a_fldlist(fldsMax) + type(fld_list_type), intent(inout) :: l2c_fldlist(fldsMax) + type(fld_list_type), intent(inout) :: c2l_fldlist(fldsMax) + + ! I use this as an index! + integer :: fldsToLnd_num != 0 ! From atmosphere to land (c2l) + integer :: fldsFrLnd_num != 0 ! From land to atmosphere (l2c) + integer :: fldsToAtm_num != 0 ! From land to atmosphere (c2a) + integer :: fldsFrAtm_num != 0 ! From atmosphere to land (a2c) + integer, parameter :: fldsMax = 100 + + + ! TODO (NS) : Should we move these to the land cap???? + logical :: glc_present ! .true. => running with a non-stub GLC model + logical :: rof_prognostic ! .true. => running with a prognostic ROF model + + character(len=*), parameter :: subname=trim(modname)//':[create_fldlists]' + ! TODO (NS) : I should add default value and units here..... + + fldsToLnd_num= 0 + fldsFrLnd_num= 0 + fldsToAtm_num= 0 + fldsFrAtm_num= 0 + + call ESMF_LogWrite(subname//"is called!", ESMF_LOGMSG_INFO) + + !------------------------------------------------------------------------- + ! !---- from atm ----! a2c_fldlist & c2l_fldlist + !------------------------------------------------------------------------- + !--------------------------a2c_fldlist------------------------------------ + ! from atm - states + !call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_z' ) + !call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_topo' ) + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_z' , default_value=30.0 , units='m/s') + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_topo' , default_value=10.0 , units='m') + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_u' , default_value=0.0 , units='m/s') + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_v' , default_value=0.0 , units='m/s') + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_ptem' , default_value=280.0 , units='degK') + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_pbot' , default_value=100100.0 , units='pa' ) + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_tbot' , default_value=280.0 , units='degk' ) + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_shum' , default_value=0.0004 , units='kg/kg' ) + !call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Sa_methane' ) + + call ESMF_LogWrite(subname//"from atmosphere states are added!" , ESMF_LOGMSG_INFO) + + + + + + ! from atm - fluxes + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_lwdn' , default_value=200.0 , units='W/m2' ) + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_rainc' , default_value=4.0e-8 , units='kg/m2s' ) + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_rainl' , default_value=3.0e-8 , units='kg/m2s' ) + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_snowc' , default_value=1.0e-8 , units='kg/m2s' ) + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_snowl' , default_value=2.0e-8 , units='kg/m2s' ) + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_swndr' , default_value=100.0 , units='W/m2' ) + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_swvdr' , default_value=90.0 , units='W/m2' ) + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_swndf' , default_value=20.0 , units='W/m2' ) + call fldlist_add(fldsToLnd_num , a2c_fldlist , 'Faxa_swvdf' , default_value=40.0 , units='W/m2' ) + + call ESMF_LogWrite(subname//"from atmosphere fluxes are added!", ESMF_LOGMSG_INFO) + + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphidry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphodry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphiwet') + + !--------------------------c2l_fldlist------------------------------------ + ! from atm - states + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_z' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_topo' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_u' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_v' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_ptem' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_pbot' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_tbot' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_shum' ) + !call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Sa_methane' ) + call ESMF_LogWrite(subname//"from atmosphere states are added!", ESMF_LOGMSG_INFO) + + ! from atm - fluxes + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_lwdn' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_rainc' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_rainl' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_snowc' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_snowl' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_swndr' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_swvdr' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_swndf' ) + call fldlist_add(fldsToLnd_num, c2l_fldlist, 'Faxa_swvdf' ) + call ESMF_LogWrite(subname//"from atmosphere fluxes are added!", ESMF_LOGMSG_INFO) + + !------------------------------------------------------------------------- + ! !---- from lnd ----! l2c_fldlist & c2a_fldlist + !------------------------------------------------------------------------- + !--------------------------l2c_fldlist------------------------------------ + ! export land states + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_lfrin' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_t' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_tref' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_qref' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_avsdr' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_anidr' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_avsdf' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_anidf' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_snowh' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_u10' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_fv' ) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Sl_ram1' ) + call ESMF_LogWrite(subname//"l2c: from land states are added!", ESMF_LOGMSG_INFO) + + rof_prognostic = .false. + ! export fluxes to river + if (rof_prognostic) then + call ESMF_LogWrite(subname//"Okay we are in rof_prognostic", ESMF_LOGMSG_INFO) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Flrl_rofsur' ) + call ESMF_LogWrite(subname//"Okay we are in rof_prognostic 13", ESMF_LOGMSG_INFO) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Flrl_rofgwl' ) + call ESMF_LogWrite(subname//"Okay we are in rof_prognostic 14", ESMF_LOGMSG_INFO) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Flrl_rofsub' ) + call ESMF_LogWrite(subname//"Okay we are in rof_prognostic 15", ESMF_LOGMSG_INFO) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Flrl_rofi' ) + call ESMF_LogWrite(subname//"Okay we are in rof_prognostic 16", ESMF_LOGMSG_INFO) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Flrl_irrig' ) + call ESMF_LogWrite(subname//"l2c: from land states are added for rof_prognostic!", ESMF_LOGMSG_INFO) + end if + + ! export fluxes to atm + call ESMF_LogWrite(subname//"l2c: now adding fluxes to atmosphere!", ESMF_LOGMSG_INFO) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_taux' ) + call ESMF_LogWrite(subname//"l2c: Fall_taux!", ESMF_LOGMSG_INFO) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_tauy' ) + call ESMF_LogWrite(subname//"l2c: Fall_taux!", ESMF_LOGMSG_INFO) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_lat' ) + call ESMF_LogWrite(subname//"l2c: Fall_lat!", ESMF_LOGMSG_INFO) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_sen' ) + call ESMF_LogWrite(subname//"l2c: Fall_sen!", ESMF_LOGMSG_INFO) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_lwup' ) + call ESMF_LogWrite(subname//"l2c: Fall_lwup!", ESMF_LOGMSG_INFO) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_evap' ) + call ESMF_LogWrite(subname//"l2c: Fall_evap!", ESMF_LOGMSG_INFO) + call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_swnet' ) + call ESMF_LogWrite(subname//"l2c: Fall_lat!", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"l2c: from land fluxes are added!", ESMF_LOGMSG_INFO) + + ! call fldlist_add(fldsFrLnd_num, l2c_fldlist, 'Fall_methane' ) + + + !--------------------------c2a_fldlist------------------------------------ + ! export land states + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_lfrin' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_t' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_tref' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_qref' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_avsdr' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_anidr' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_avsdf' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_anidf' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_snowh' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_u10' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_fv' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Sl_ram1' ) + + + ! export fluxes to river + if (rof_prognostic) then + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Flrl_rofsur' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Flrl_rofgwl' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Flrl_rofsub' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Flrl_rofi' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Flrl_irrig' ) + end if + + ! export fluxes to atm + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_taux' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_tauy' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_lat' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_sen' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_lwup' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_evap' ) + call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_swnet' ) + + ! call fldlist_add(fldsFrLnd_num, c2a_fldlist, 'Fall_methane' ) + + + + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'atmos2lnd_var', default_value=0.0, units='m') + ! from lnd + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'lnd2atmos_var', default_value=0.0, units='m') + + + ! sets the module variable memory in atmos_cap.F9 print *, a2c_fldlist(1)%stdname + !!! First from atmosphere to land fields + ! import fields + ! call fldlist_add(fldsFrCpl_num, fldsFrCpl, trim(flds_scalar_name)) + + !call fldlist_add(fldsToLnd_num, fldsToLnd, trim(flds_scalar_name)) + + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_topo') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_u', default_value=0.0, units='m/s') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_v', default_value=0.0, units='m/s') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_ptem', default_value=280.0, units= 'degK') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_pbot', default_value=100100.0, units='Pa') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_tbot', default_value=280.0, units='degK') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_shum', default_value=0.0004, units='kg/kg') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Sa_methane' ) + + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_lwdn', default_value=200.0, units='W/m2') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainc', default_value=4.0e-8, units='kg/m2s') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_rainl', default_value=3.0e-8, units='kg/m2s') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowc', default_value=1.0e-8, units='kg/m2s') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_snowl', default_value=2.0e-8, units='kg/m2s') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndr', default_value=100.0, units='W/m2') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdr', default_value=90.0, units='W/m2') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swndf', default_value=20.0, units='W/m2') + !call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_swvdf', default_value=40.0, units='W/m2') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphidry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphodry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_bcphiwet') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphidry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphodry') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_ocphiwet') + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry1' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry2' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry3' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstdry4' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet1' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet2' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet3' ) + ! call fldlist_add(fldsToCpl_num, fldsToCpl, 'Faxa_dstwet4' ) + + ! land states + + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_lfrin' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_t' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_tref' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_qref' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdr' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidr' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_avsdf' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_anidf' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_snowh' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_u10' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_fv' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Sl_ram1' ) + + ! fluxes to atm + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_taux' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_tauy' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lat' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_sen' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_lwup' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_evap' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_swnet' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst1' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst2' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst3' ) + !call fldlist_add(fldsFrCpl_num, fldsFrCpl, 'Fall_flxdst4' ) + + + + ! more: https://github.com/mvertens/ctsm/blob/ae02ffe25dbc4a85c769c9137b5b3d50f2843e89/src/cpl/nuopc/lnd_import_export.F90#L131 + end subroutine create_fldlists + +end module lilac_utils diff --git a/lilac/lilac/lnd_cap.F90 b/lilac/lilac/lnd_cap.F90 new file mode 100644 index 0000000000..3e73d4e6c1 --- /dev/null +++ b/lilac/lilac/lnd_cap.F90 @@ -0,0 +1,250 @@ +module lnd_cap + use ESMF + use lilac_utils, only : fld_list_type + + implicit none + + character(*), parameter :: modname = " lnd_cap" + + !!integer, parameter :: fldsMax = 100 + + type(ESMF_Field), public, save :: field + type(ESMF_Field), public, save :: field_sie, field_u + + type(fld_list_type), public, allocatable :: c2l_fldlist(:) + type(fld_list_type), public, allocatable :: l2c_fldlist(:) + + !private + + public lnd_register + !public :: add_fields + !public :: import_fields + !public :: export_fields + + contains + +!------------------------------------------------------------------------- +! land register +!------------------------------------------------------------------------- + subroutine lnd_register(comp, rc) + + type(ESMF_GridComp) :: comp ! must not be optional + integer, intent(out) :: rc + character(len=*), parameter :: subname=trim(modname)//': [lnd_register] ' + + print *, "in lnd register routine" + + rc = ESMF_SUCCESS + ! Set the entry points for standard ESMF Component methods + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=lnd_init, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=lnd_run, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=lnd_final, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + end subroutine lnd_register + +!------------------------------------------------------------------------- +! land init +!------------------------------------------------------------------------- + + subroutine lnd_init(comp, atm2lnd_l_state, lnd2atm_l_state, clock, rc) + + type (ESMF_GridComp) :: comp + type (ESMF_State) :: atm2lnd_l_state, lnd2atm_l_state + type (ESMF_Clock) :: clock + integer, intent(out) :: rc + + type (ESMF_FieldBundle) :: l2c_fb , c2l_fb + integer :: n + + + logical mesh_switch + integer :: petCount, localrc, urc + type(ESMF_Mesh) :: lnd_mesh + character(len=ESMF_MAXSTR) :: lnd_mesh_filepath + + character(len=*), parameter :: subname=trim(modname)//': [lnd_init] ' + + type(ESMF_Grid) :: lnd_grid + + integer :: c2l_fldlist_num + integer :: l2c_fldlist_num + !integer :: regDecomp(:,:) + + ! Initialize return code + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//"------------------------!", ESMF_LOGMSG_INFO) + + call ESMF_GridCompGet(comp, petcount=petcount, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + + print *, " Empty land is created !!!!" + print *, "in land routine routine" + !------------------------------------------------------------------------- + ! Read in the mesh ----or----- Generate the grid + !------------------------------------------------------------------------- + mesh_switch = .true. + if(mesh_switch) then + print *, "creating mesh for land" + ! For now this is our dummy mesh: + !lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T31_040122_ESMFmesh.nc' !! T31 and T62 did not work.... + !lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/T62_040121_ESMFmesh.nc' + lnd_mesh_filepath = '/gpfs/fs1/p/cesmdata/cseg/inputdata/share/meshes/fv4x5_050615_polemod_ESMFmesh.nc' + lnd_mesh = ESMF_MeshCreate(filename=trim(lnd_mesh_filepath), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Mesh for land is created!", ESMF_LOGMSG_INFO) + print *, "!Mesh for land is created!" + else + lnd_grid = ESMF_GridCreateNoPeriDimUfrm( minIndex= (/1,1/), maxIndex=(/180,360 /), & + maxCornerCoord=(/180._ESMF_KIND_R8, 360._ESMF_KIND_R8/), & + minCornerCoord=(/0._ESMF_KIND_R8, 0._ESMF_KIND_R8/), & + coordSys=ESMF_COORDSYS_CART,& + regDecomp=(/petcount,1/),& + rc=rc) + call ESMF_GridCompGet(comp, grid= lnd_grid , petcount=petcount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_LogWrite(subname//"Grid for land is created!", ESMF_LOGMSG_INFO) + print *, "Grid for land is created!" + endif + + + + !------------------------------------------------------------------------- + ! Coupler (land) to Atmosphere Fields -- l2a + ! I- Create Field Bundle -- l2c_fb for now + ! II- Create Fields and add them to field bundle + ! III - Add l2c_fb to state (lnd2atm_l_state) + !------------------------------------------------------------------------- + + l2c_fb = ESMF_FieldBundleCreate (name="l2c_fb", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + print *, 'l2c_fb is created' + ! Create individual fields and add to field bundle -- l2a + l2c_fldlist_num = 3 + + do n = 1,l2c_fldlist_num + + ! create field + !!! Here we want to pass pointers + if (mesh_switch) then + field = ESMF_FieldCreate(lnd_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(l2c_fldlist(n)%stdname), rc=rc) + !field = ESMF_FieldCreate(lnd_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(l2c_fldlist(n)%stdname), farrayPtr=l2c_fldlist(n)%farrayptr1d, rc= + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + else + field = ESMF_FieldCreate(lnd_grid, name=trim(l2c_fldlist(n)%stdname), farrayPtr=l2c_fldlist(n)%farrayptr2d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + end if + ! add field to field bundle + call ESMF_FieldBundleAdd(l2c_fb, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + print *, "**********************************************************" + print *, "creating field for l2a:" + print *, trim(l2c_fldlist(n)%stdname) + print *, l2c_fldlist(n)%farrayptr1d + + enddo + + print *, "!Fields For Coupler (l2c_fldlist) Field Bundle Created!" + + ! Add field bundle to state + call ESMF_StateAdd(lnd2atm_l_state, (/l2c_fb/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + print *, "!lnd2atm_l_state is filld with dummy_var field bundle!" + + + !------------------------------------------------------------------------- + ! Atmosphere to Coupler (land) Fields -- a2l + ! I- Create empty field bundle -- c2l_fb + ! II- Create Fields and add them to field bundle + ! III - Add c2l_fb to state (atm2lnd_l_state) + !------------------------------------------------------------------------- + + c2l_fb = ESMF_FieldBundleCreate(name="c2l_fb", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + ! Create individual fields and add to field bundle -- a2l + + !call fldlist_add(c2l_fldlist_num, c2l_fldlist, 'dum_var2' ) + c2l_fldlist_num = 3 + + do n = 1,c2l_fldlist_num + + ! create field + !!! Here we want to pass pointers + field = ESMF_FieldCreate(lnd_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(c2l_fldlist(n)%stdname), rc=rc) + !field = ESMF_FieldCreate(lnd_mesh, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(c2l_fldlist(n)%stdname), farrayPtr=c2l_fldlist(n)%farrayptr1d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + !call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) + !fldptr = c2l_fldlist(n)%default_value + + ! add field to field bundle + call ESMF_FieldBundleAdd(c2l_fb, (/field/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + + + print *, "**********************************************************" + print *, "creating field for a2l:" + print *, trim(c2l_fldlist(n)%stdname) + print *, c2l_fldlist(n)%farrayptr1d + + enddo + + print *, "!Fields to Coupler (atmos to land ) (c2l_fb) Field Bundle Created!" + + ! Add field bundle to state + call ESMF_StateAdd(atm2lnd_l_state, (/c2l_fb/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! bail out + print *, "!atm2lnd_l_state is filld with dummy_var field bundle!" + + + + end subroutine lnd_init + +!------------------------------------------------------------------------- +! land run +!------------------------------------------------------------------------- + subroutine lnd_run(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//': [lnd_run] ' + + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"lnd_run has not been implemented yet", ESMF_LOGMSG_INFO) + + end subroutine lnd_run + +!------------------------------------------------------------------------- +! land final +!------------------------------------------------------------------------- + subroutine lnd_final(comp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: comp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=*), parameter :: subname=trim(modname)//': [lnd_final] ' + + ! Initialize return code + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//"lnd_final is called but has not been implemented yet", ESMF_LOGMSG_INFO) + + end subroutine lnd_final + !=============================================================================== + + + + + +end module lnd_cap diff --git a/lilac/tests/CMakeLists.txt b/lilac/tests/CMakeLists.txt index 6361d9e9c2..09a90942c8 100644 --- a/lilac/tests/CMakeLists.txt +++ b/lilac/tests/CMakeLists.txt @@ -1,2 +1,2 @@ # Add tests here -add_subdirectory(hello_world) +target_include_directories(lilac PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}) diff --git a/lilac/tests/hello_world/CMakeLists.txt b/lilac/tests/hello_world/CMakeLists.txt deleted file mode 100644 index 0e5fbd44bc..0000000000 --- a/lilac/tests/hello_world/CMakeLists.txt +++ /dev/null @@ -1,3 +0,0 @@ -file(GLOB_RECURSE SOURCES *.f90 *.h) -add_executable("test_hello_world" ${SOURCES} ) -target_link_libraries(lilac) diff --git a/lilac/tests/hello_world/main.f90 b/lilac/tests/hello_world/main.f90 deleted file mode 100644 index 78312075c1..0000000000 --- a/lilac/tests/hello_world/main.f90 +++ /dev/null @@ -1,21 +0,0 @@ -program main - - ! modules - use ESMF - ! use lilac, ONLY : lilac_init - - implicit none - - ! local variables - integer:: rc - - ! call lilac_init() - ! TODO fix linking with lilac - call ESMF_Initialize(rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - print *, "Hello LILAC World" - - call ESMF_Finalize() - -end program main diff --git a/lilac/tests/rand_atm_rand_lnd/CmakeLists.txt b/lilac/tests/rand_atm_rand_lnd/CmakeLists.txt deleted file mode 100644 index c7c253746b..0000000000 --- a/lilac/tests/rand_atm_rand_lnd/CmakeLists.txt +++ /dev/null @@ -1,4 +0,0 @@ - -file(GLOB TEST_SOURCES *.f90 *.h) -add_executable(rand_atm_rand_land ${TEST_SOURCES} ) -target_link_libraries(rand_atm_rand_land) diff --git a/lilac/tests/rand_atm_rand_lnd/main.f90 b/lilac/tests/rand_atm_rand_lnd/main.f90 deleted file mode 100644 index f0c343cc4f..0000000000 --- a/lilac/tests/rand_atm_rand_lnd/main.f90 +++ /dev/null @@ -1,5 +0,0 @@ -program main - - - -end program main