From bc40b77a75625011ad055dc7edbf498559581c83 Mon Sep 17 00:00:00 2001 From: Min Xu Date: Wed, 30 Jan 2019 22:56:20 -0500 Subject: [PATCH 01/54] Change the IBM Fortran and C wrappers on Summit Change the IBM Fortran and C wrappers from the Fortran 77 to Fortran 90 functionality and change their MPI wrappers to the common names (i.e. mpif90, mpicc, and mpicxx) --- config/e3sm/machines/config_compilers.xml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/config/e3sm/machines/config_compilers.xml b/config/e3sm/machines/config_compilers.xml index 74a3530ec53a..29d587001394 100644 --- a/config/e3sm/machines/config_compilers.xml +++ b/config/e3sm/machines/config_compilers.xml @@ -1780,12 +1780,12 @@ ntel/x86_64/2013/composer_xe_2013/composer_xe_2013_sp1.3.174/mkl/include -L$ENV{PNETCDF_PATH}/lib -lpnetcdf -L$ENV{HDF5_PATH}/lib -lhdf5_hl -lhdf5 -Wl,--relax -Wl,--allow-multiple-definition - mpixlc - mpixlC - mpixlf + mpicc + mpicxx + mpif90 gpfs xlc_r - xlf_r + xlf90_r From 67e4c41c5769bc904c4722c09391a8b5e01e813b Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Fri, 8 Feb 2019 16:33:30 -0800 Subject: [PATCH 02/54] modified log message in shr_strdata_mod changed the message about setting the domain to only print for the master task since it was unnecessarily cluttering up the log files. modified: cime/src/share/streams/shr_strdata_mod.F90 --- src/share/streams/shr_strdata_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/share/streams/shr_strdata_mod.F90 b/src/share/streams/shr_strdata_mod.F90 index 4903e4fde07e..ba170dddc63a 100644 --- a/src/share/streams/shr_strdata_mod.F90 +++ b/src/share/streams/shr_strdata_mod.F90 @@ -381,7 +381,7 @@ subroutine shr_strdata_init_model_domain(SDAT, mpicom, compid, my_task, & if (present(reset_domain_mask)) then if (reset_domain_mask) then - write(logunit,F00) ' Resetting the component domain mask and frac to 1' + if (my_task == master_task) write(logunit,F00) ' Resetting the component domain mask and frac to 1' kmask = mct_aVect_indexRA(SDAT%grid%data,'mask') SDAT%grid%data%rattr(kmask,:) = 1 From ce23a4e797a5f35293499d2508fca37c45ef1dbc Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Sat, 16 Feb 2019 14:32:51 -0800 Subject: [PATCH 03/54] Changed aqua compsets in intergration test The tests currently won't work until an ne4 initial condition file is created. modified: cime/config/e3sm/tests.py --- config/e3sm/tests.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config/e3sm/tests.py b/config/e3sm/tests.py index 30e20ee77927..c252cc4cf1e9 100644 --- a/config/e3sm/tests.py +++ b/config/e3sm/tests.py @@ -37,8 +37,8 @@ ), "e3sm_atm_integration" : (None, None, - ("ERP_Ln9.ne4_ne4.FC5AV1C-L-AQUAP", - ("SMS_Ld1.ne4_ne4.FC5AV1C-L-AQUAP","cam-clubb_only"), + ("ERP_Ln9.ne4_ne4.F-EAMv1-AQP1", + ("SMS_Ld1.ne4_ne4.F-EAMv1-AQP1","cam-clubb_only"), ("PET_Ln5.ne4_ne4.FC5AV1C-L","allactive-mach-pet"), "PEM_Ln5.ne4_ne4.FC5AV1C-L", ("SMS_D_Ln5.ne4_ne4.FC5AV1C-L", "cam-cosplite_nhtfrq5"), From 598e87f8451a7f53d21d640373f6aed4c29d0830 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Thu, 28 Mar 2019 10:17:20 -0500 Subject: [PATCH 04/54] update anvil config files to use condo nodes --- config/e3sm/machines/config_batch.xml | 10 +- config/e3sm/machines/config_compilers.xml | 22 ++-- config/e3sm/machines/config_machines.xml | 149 ++++++++++++---------- 3 files changed, 98 insertions(+), 83 deletions(-) diff --git a/config/e3sm/machines/config_batch.xml b/config/e3sm/machines/config_batch.xml index a5cf2c330a96..b226e52b397d 100644 --- a/config/e3sm/machines/config_batch.xml +++ b/config/e3sm/machines/config_batch.xml @@ -277,14 +277,14 @@ - - - + + + - acme + acme diff --git a/config/e3sm/machines/config_compilers.xml b/config/e3sm/machines/config_compilers.xml index 2522ff861f10..9e76a6c6d839 100644 --- a/config/e3sm/machines/config_compilers.xml +++ b/config/e3sm/machines/config_compilers.xml @@ -716,38 +716,42 @@ for mct, etc. - -DHAVE_NANOTIME -DBIT64 -DHAVE_SLASHPROC -DHAVE_GETTIMEOFDAY + -DHAVE_NANOTIME -DBIT64 -DHAVE_SLASHPROC -DHAVE_GETTIMEOFDAY gpfs - $SHELL{$ENV{NETCDF_PATH}/bin/nf-config --flibs} -llapack -lblas + $SHELL{$ENV{NETCDF_FORTRAN_PATH}/bin/nf-config --flibs} -L$ENV{MKLROOT}/lib/intel64 -Wl,--no-as-needed -lmkl_intel_lp64 -lmkl_intel_thread -lmkl_core -liomp5 -lpthread -lm -ldl - + -DHAVE_SLASHPROC -O2 -debug minimal -qno-opt-dynamic-align - -static-intel - -heap-arrays + - + - $SHELL{$ENV{NETCDF_PATH}/bin/nf-config --flibs} -Wl,-rpath -Wl,$ENV{NETCDF_PATH}/lib + $SHELL{$ENV{NETCDF_FORTRAN_PATH}/bin/nf-config --flibs} -Wl,-rpath -Wl,$ENV{NETCDF_FORTRAN_PATH}/lib -mkl + mpiicc + mpiicpc + mpiifort + diff --git a/config/e3sm/machines/config_machines.xml b/config/e3sm/machines/config_machines.xml index 40339510df6f..7dfdc8ebf2e8 100644 --- a/config/e3sm/machines/config_machines.xml +++ b/config/e3sm/machines/config_machines.xml @@ -1125,11 +1125,11 @@ ANL/LCRC Linux Cluster - blogin.*.lcrc.anl.gov + blueslogin.*.lcrc.anl.gov LINUX - intel,gnu,pgi - mvapich,openmpi - ACME + intel,gnu + mvapich,impi,openmpi + condo /lcrc/group/acme .* /lcrc/group/acme/$USER/acme_scratch/anvil @@ -1140,106 +1140,117 @@ /home/ccsm-data/tools/cprnc 8 e3sm_integration - pbs + slurm E3SM 36 36 FALSE - - mpiexec - - -n {{ total_tasks }} - --map-by ppr:{{ tasks_per_numa }}:socket:PE=$ENV{OMP_NUM_THREADS} --bind-to core - - - - - mpiexec + + mpirun - -l -n {{ total_tasks }} - - /etc/profile.d/a_softenv.csh - /etc/profile.d/a_softenv.sh - soft - soft + + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/sh + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/csh + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/perl + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/env_modules_python.py + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/libexec/lmod perl + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/libexec/lmod python + module + module - +cmake-2.8.12 - +python-2.7 + - +intel-17.0.0 - +netcdf-c-4.4.1-f77-4.4.4-intel-17.0.0-serial + intel/18.0.4-443hhug + intel-mkl/2018.4.274-jwaeshj + + + mpich/3.3-verbs-at6arvo - +mvapich2-2.2-intel-17.0.0-acme - +pnetcdf-1.7.0-intel-17.0.0-mvapich2-2.2-acme + mvapich2/2.3-verbs-jxfqudp + hdf5/1.10.4-b2aw6ri + netcdf-cxx/4.2-fevpvbh + netcdf-fortran/4.4.4-25yzbsw + netcdf/4.6.2-xf4e6n6 + parallel-netcdf/1.11.0-7kvr6ax - +openmpi-2.0.1-intel-17.0.0-acme - +pnetcdf-1.7.0-intel-17.0.0-openmpi-2.0.1-acme - + openmpi/3.1.3-verbs-kqojjbw + hdf5/1.10.4-uitg4of + netcdf-cxx/4.2-crwzy3r + netcdf-fortran/4.4.4-fve36ga + netcdf/4.6.2-3jynwg5 + + + + intel-mpi/2018.4.274-4hmwfl6 + hdf5/1.10.4-zlri7fo + netcdf/4.6.2-64hby3x + netcdf-fortran/4.4.4-hr5agu5 + netcdf-cxx/4.2-efl7ntf + parallel-netcdf/1.11.0-acswzws + + - +gcc-5.3.0 - +netcdf-c-4.4.0-f77-4.4.3-gcc-5.3.0-serial + gcc/8.2.0-g7hppkz + intel-mkl/2018.4.274-2amycpi - +mvapich2-2.2b-gcc-5.3.0-acme - +pnetcdf-1.6.1-gcc-5.3.0-mvapich2-2.2b-acme + mvapich2/2.3-verbs-yyaahvp + hdf5/1.10.5-va2annc + netcdf/4.6.3-pj7p2s7 + netcdf-cxx/4.2-gxtq6xt + netcdf-fortran/4.4.4-togj5w5 + parallel-netcdf/1.11.0-e5iciuq - +openmpi-1.10.2-gcc-5.3.0-acme - +pnetcdf-1.6.1-gcc-5.3.0-openmpi-1.10.2-acme + openmpi/3.1.3-verbs-q4swt25 + hdf5/1.10.5-kuyb5xe + netcdf/4.6.3-xcyxt2i + netcdf-fortran/4.4.4-tad5qcj + netcdf-cxx/4.2-2dftcw4 + parallel-netcdf/1.11.0-g7mipbc + + + intel-mpi/2018.4.274-ozfo327 + hdf5/1.10.5-vozfsah + netcdf/4.6.3-c2b5ohk + netcdf-fortran/4.4.4-x323ez3 + netcdf-cxx/4.2-skdn4fw + parallel-netcdf/1.11.0-filvnis - - +pgi-16.3 - +netcdf-c-4.4.0-f77-4.4.3-pgi-16.3-serial - - - +mvapich2-2.2b-pgi-16.3-acme - +pnetcdf-1.6.1-pgi-16.3-mvapich2-2.2b-acme - - - +openmpi-1.10.2-pgi-16.3-acme - +pnetcdf-1.6.1-pgi-16.3-openmpi-1.10.2-acme + + cmake + $CIME_OUTPUT_ROOT/$CASE/run $CIME_OUTPUT_ROOT/$CASE/bld + 0.1 - $SHELL{which nf-config | xargs dirname | xargs dirname} + $SHELL{which nc-config | xargs dirname | xargs dirname} + $SHELL{which nf-config | xargs dirname | xargs dirname} + /lcrc/group/acme/soft/perl/5.26.0/bin:$ENV{PATH} $SHELL{which pnetcdf_version | xargs dirname | xargs dirname} - 64M - 1 - - - scatter - - - verbose,scatter - verbose - - - 1 - 1 - 1 - - - - $SHELL{t=$ENV{OMP_NUM_THREADS};b=0;r=$[36/$t];while [ $r -gt 0 ];do printf "$b-$[$b+$t-1]:";((r--));((b=b+t));done;} + 128M + spread + threads - - 1 + + shm:tmi From bdee00fa47bedcda1ed1953c291f8706aa26f6c3 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Thu, 28 Mar 2019 11:26:12 -0500 Subject: [PATCH 05/54] add fixed intel-openmpi module to new anvil build --- config/e3sm/machines/config_machines.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config/e3sm/machines/config_machines.xml b/config/e3sm/machines/config_machines.xml index 7dfdc8ebf2e8..8d632c358514 100644 --- a/config/e3sm/machines/config_machines.xml +++ b/config/e3sm/machines/config_machines.xml @@ -1187,7 +1187,7 @@ netcdf-cxx/4.2-crwzy3r netcdf-fortran/4.4.4-fve36ga netcdf/4.6.2-3jynwg5 - + parallel-netcdf/1.11.0-e7zc5da intel-mpi/2018.4.274-4hmwfl6 From 4137eb66cdfed1f88275b338946d772785a9277a Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Fri, 29 Mar 2019 16:27:12 -0500 Subject: [PATCH 06/54] cleanup --- config/e3sm/machines/config_batch.xml | 7 ---- config/e3sm/machines/config_compilers.xml | 13 +++---- config/e3sm/machines/config_machines.xml | 45 ++++++++++++++++------- 3 files changed, 37 insertions(+), 28 deletions(-) diff --git a/config/e3sm/machines/config_batch.xml b/config/e3sm/machines/config_batch.xml index b226e52b397d..a3e8a30fca14 100644 --- a/config/e3sm/machines/config_batch.xml +++ b/config/e3sm/machines/config_batch.xml @@ -265,7 +265,6 @@ - -A {{ PROJECT }} @@ -277,12 +276,7 @@ - - acme @@ -296,7 +290,6 @@ - -A {{ project }} diff --git a/config/e3sm/machines/config_compilers.xml b/config/e3sm/machines/config_compilers.xml index 9e76a6c6d839..458f9510c670 100644 --- a/config/e3sm/machines/config_compilers.xml +++ b/config/e3sm/machines/config_compilers.xml @@ -725,25 +725,25 @@ for mct, etc. - + -DHAVE_SLASHPROC -O2 -debug minimal -qno-opt-dynamic-align - + -static-intel + -heap-arrays - + gpfs $SHELL{$ENV{NETCDF_FORTRAN_PATH}/bin/nf-config --flibs} -Wl,-rpath -Wl,$ENV{NETCDF_FORTRAN_PATH}/lib -mkl @@ -751,7 +751,6 @@ for mct, etc. mpiicc mpiicpc mpiifort - diff --git a/config/e3sm/machines/config_machines.xml b/config/e3sm/machines/config_machines.xml index 8d632c358514..41f6a271935d 100644 --- a/config/e3sm/machines/config_machines.xml +++ b/config/e3sm/machines/config_machines.xml @@ -1145,21 +1145,27 @@ 36 36 FALSE + + mpiexec + + -n {{ total_tasks }} + --map-by ppr:{{ tasks_per_numa }}:socket:PE=$ENV{OMP_NUM_THREADS} --bind-to core + + + mpirun - -n {{ total_tasks }} + -l -n {{ total_tasks }} - /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/sh + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/sh /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/csh - /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/perl /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/env_modules_python.py - /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/libexec/lmod perl /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/libexec/lmod python module module @@ -1170,9 +1176,6 @@ intel/18.0.4-443hhug intel-mkl/2018.4.274-jwaeshj - - mpich/3.3-verbs-at6arvo - mvapich2/2.3-verbs-jxfqudp hdf5/1.10.4-b2aw6ri @@ -1229,13 +1232,11 @@ cmake - $CIME_OUTPUT_ROOT/$CASE/run $CIME_OUTPUT_ROOT/$CASE/bld 0.1 + 1000 $SHELL{which nc-config | xargs dirname | xargs dirname} $SHELL{which nf-config | xargs dirname | xargs dirname} @@ -1244,14 +1245,30 @@ $SHELL{which pnetcdf_version | xargs dirname | xargs dirname} + + 1 + 0 + + + 1 + 1 + 2 + - 128M + 64M + + + + $SHELL{t=$ENV{OMP_NUM_THREADS};b=0;r=$[36/$t];while [ $r -gt 0 ];do printf "$b-$[$b+$t-1]:";((r--));((b=b+t));done;} + + + granularity=thread,scatter + 1 + + spread threads - - shm:tmi - From e2a0672efb7684ef6405c433f3dd8b58b88e1621 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Tue, 2 Apr 2019 16:21:45 -0500 Subject: [PATCH 07/54] revert anvil netcdf and hdf5 libraries to known working version --- config/e3sm/machines/config_compilers.xml | 7 ++- config/e3sm/machines/config_machines.xml | 58 ++++++++--------------- 2 files changed, 22 insertions(+), 43 deletions(-) diff --git a/config/e3sm/machines/config_compilers.xml b/config/e3sm/machines/config_compilers.xml index 458f9510c670..5835a56bcd63 100644 --- a/config/e3sm/machines/config_compilers.xml +++ b/config/e3sm/machines/config_compilers.xml @@ -721,6 +721,7 @@ for mct, etc. gpfs $SHELL{$ENV{NETCDF_FORTRAN_PATH}/bin/nf-config --flibs} -L$ENV{MKLROOT}/lib/intel64 -Wl,--no-as-needed -lmkl_intel_lp64 -lmkl_intel_thread -lmkl_core -liomp5 -lpthread -lm -ldl + $SHELL{$ENV{NETCDF_C_PATH}/bin/nc-config --libs} @@ -745,12 +746,10 @@ for mct, etc. gpfs - $SHELL{$ENV{NETCDF_FORTRAN_PATH}/bin/nf-config --flibs} -Wl,-rpath -Wl,$ENV{NETCDF_FORTRAN_PATH}/lib + $SHELL{$ENV{NETCDF_FORTRAN_PATH}/bin/nf-config --flibs} + $SHELL{$ENV{NETCDF_C_PATH}/bin/nc-config --libs} -mkl - mpiicc - mpiicpc - mpiifort diff --git a/config/e3sm/machines/config_machines.xml b/config/e3sm/machines/config_machines.xml index 41f6a271935d..467e583236f9 100644 --- a/config/e3sm/machines/config_machines.xml +++ b/config/e3sm/machines/config_machines.xml @@ -1128,7 +1128,7 @@ blueslogin.*.lcrc.anl.gov LINUX intel,gnu - mvapich,impi,openmpi + mvapich,openmpi condo /lcrc/group/acme .* @@ -1174,60 +1174,40 @@ intel/18.0.4-443hhug - intel-mkl/2018.4.274-jwaeshj mvapich2/2.3-verbs-jxfqudp - hdf5/1.10.4-b2aw6ri - netcdf-cxx/4.2-fevpvbh - netcdf-fortran/4.4.4-25yzbsw - netcdf/4.6.2-xf4e6n6 - parallel-netcdf/1.11.0-7kvr6ax + parallel-netcdf/1.8.1-zhkvsbx openmpi/3.1.3-verbs-kqojjbw - hdf5/1.10.4-uitg4of - netcdf-cxx/4.2-crwzy3r - netcdf-fortran/4.4.4-fve36ga - netcdf/4.6.2-3jynwg5 - parallel-netcdf/1.11.0-e7zc5da - - - intel-mpi/2018.4.274-4hmwfl6 - hdf5/1.10.4-zlri7fo - netcdf/4.6.2-64hby3x - netcdf-fortran/4.4.4-hr5agu5 - netcdf-cxx/4.2-efl7ntf - parallel-netcdf/1.11.0-acswzws + parallel-netcdf/1.8.1-5ldccd7 + + + intel-mkl/2018.4.274-jwaeshj + hdf5/1.8.16-n5thgua + netcdf/4.4.1-qs32hcj + netcdf-cxx/4.2-fevpvbh + netcdf-fortran/4.4.4-jy3v3rz gcc/8.2.0-g7hppkz - intel-mkl/2018.4.274-2amycpi mvapich2/2.3-verbs-yyaahvp - hdf5/1.10.5-va2annc - netcdf/4.6.3-pj7p2s7 - netcdf-cxx/4.2-gxtq6xt - netcdf-fortran/4.4.4-togj5w5 - parallel-netcdf/1.11.0-e5iciuq + parallel-netcdf/1.8.1-m4l6rud openmpi/3.1.3-verbs-q4swt25 - hdf5/1.10.5-kuyb5xe - netcdf/4.6.3-xcyxt2i - netcdf-fortran/4.4.4-tad5qcj - netcdf-cxx/4.2-2dftcw4 - parallel-netcdf/1.11.0-g7mipbc - - - intel-mpi/2018.4.274-ozfo327 - hdf5/1.10.5-vozfsah - netcdf/4.6.3-c2b5ohk - netcdf-fortran/4.4.4-x323ez3 - netcdf-cxx/4.2-skdn4fw - parallel-netcdf/1.11.0-filvnis + parallel-netcdf/1.8.1-re3um7k + + + intel-mkl/2018.4.274-2amycpi + hdf5/1.8.16-mz7lmxh + netcdf/4.4.1-xkjcghm + netcdf-cxx/4.2-kyva3os + netcdf-fortran/4.4.4-mpstomu cmake From f5078dbca01d248cb23e04cf0e633f733c252346 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Tue, 2 Apr 2019 17:18:54 -0500 Subject: [PATCH 08/54] anvil module - avoid openmpi 3.1.3 binding bug --- config/e3sm/machines/config_machines.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config/e3sm/machines/config_machines.xml b/config/e3sm/machines/config_machines.xml index 467e583236f9..73629e393a9b 100644 --- a/config/e3sm/machines/config_machines.xml +++ b/config/e3sm/machines/config_machines.xml @@ -1149,7 +1149,7 @@ mpiexec -n {{ total_tasks }} - --map-by ppr:{{ tasks_per_numa }}:socket:PE=$ENV{OMP_NUM_THREADS} --bind-to core + --map-by ppr:{{ tasks_per_numa }}:socket,PE=$ENV{OMP_NUM_THREADS} --bind-to core From 75bfab63d64272e03b81fa15280ab6484e13ab7f Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Wed, 3 Apr 2019 15:41:02 -0500 Subject: [PATCH 09/54] Switch from mpirun/mpiexec to srun --- config/e3sm/machines/config_machines.xml | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/config/e3sm/machines/config_machines.xml b/config/e3sm/machines/config_machines.xml index 73629e393a9b..cc2238cc56b4 100644 --- a/config/e3sm/machines/config_machines.xml +++ b/config/e3sm/machines/config_machines.xml @@ -1145,16 +1145,15 @@ 36 36 FALSE - + + - -map-by ppr:{{ tasks_per_numa }}:socket,PE=$ENV{OMP_NUM_THREADS} - -bind-to core -tag-output -report-bindings - + - mpirun + srun -l -n {{ total_tasks }} @@ -1195,8 +1194,8 @@ gcc/8.2.0-g7hppkz - mvapich2/2.3-verbs-yyaahvp - parallel-netcdf/1.8.1-m4l6rud + mvapich2/2.3.1-verbs + openmpi/3.1.3-verbs-q4swt25 @@ -1222,9 +1221,9 @@ $SHELL{which nf-config | xargs dirname | xargs dirname} /lcrc/group/acme/soft/perl/5.26.0/bin:$ENV{PATH} - + 1 0 From 8e6fdf3040b7c47de5f2c35fcd56197dfeffd162 Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Wed, 3 Apr 2019 19:27:47 -0500 Subject: [PATCH 10/54] Add intel+mvapich libs --- config/e3sm/machines/config_machines.xml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/config/e3sm/machines/config_machines.xml b/config/e3sm/machines/config_machines.xml index cc2238cc56b4..6549a5a8a0a6 100644 --- a/config/e3sm/machines/config_machines.xml +++ b/config/e3sm/machines/config_machines.xml @@ -1175,8 +1175,8 @@ intel/18.0.4-443hhug - mvapich2/2.3-verbs-jxfqudp - parallel-netcdf/1.8.1-zhkvsbx + mvapich2/2.3.1-verbs-dtbb6xk + openmpi/3.1.3-verbs-kqojjbw @@ -1186,7 +1186,7 @@ intel-mkl/2018.4.274-jwaeshj hdf5/1.8.16-n5thgua netcdf/4.4.1-qs32hcj - netcdf-cxx/4.2-fevpvbh + netcdf-fortran/4.4.4-jy3v3rz @@ -1194,7 +1194,7 @@ gcc/8.2.0-g7hppkz - mvapich2/2.3.1-verbs + mvapich2/2.3.1-verbs-wcfqbl5 From f15032a6faae365708733764fa618272da91c5e8 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 3 Apr 2019 16:41:44 -0600 Subject: [PATCH 11/54] Add support for 224x464 NLDAS regional grid --- config/cesm/config_grids.xml | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/config/cesm/config_grids.xml b/config/cesm/config_grids.xml index 11d501bb4ba9..c6dbd9bd5b7d 100644 --- a/config/cesm/config_grids.xml +++ b/config/cesm/config_grids.xml @@ -120,6 +120,15 @@ null + + + 224x464_nldas + 224x464_nldas + 224x464_nldas + null + nldas + + 360x720cru 360x720cru @@ -1093,6 +1102,13 @@ 5x5 Amazon regional case -- only valid for DATM/CLM compset + + 464 224 + $DIN_LOC_ROOT/share/domains/domain.clm/domain.lnd.224x464_nldas_224x464_nldas.190403.nc + $DIN_LOC_ROOT/share/domains/domain.clm/domain.ocn.224x464_nldas.190403.nc + Regional, 12km NLDAS grid over the U.S. + + From e81e634f830ead8cb7b5df041bc8312eff034072 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 4 Apr 2019 06:11:13 -0600 Subject: [PATCH 12/54] Remove number of grid points from nldas grid alias It would be hard for someone to remember the right number of grid points to use; this new alias is easier to remember. --- config/cesm/config_grids.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config/cesm/config_grids.xml b/config/cesm/config_grids.xml index c6dbd9bd5b7d..5ef2b0bd267c 100644 --- a/config/cesm/config_grids.xml +++ b/config/cesm/config_grids.xml @@ -121,7 +121,7 @@ - + 224x464_nldas 224x464_nldas 224x464_nldas From 38a447cf5fe1c298a03dc899989ced5a0d818a34 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 4 Apr 2019 06:30:09 -0600 Subject: [PATCH 13/54] Edit comments --- config/cesm/config_grids.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config/cesm/config_grids.xml b/config/cesm/config_grids.xml index 5ef2b0bd267c..742563a69a2d 100644 --- a/config/cesm/config_grids.xml +++ b/config/cesm/config_grids.xml @@ -120,7 +120,7 @@ null - + 224x464_nldas 224x464_nldas @@ -1106,7 +1106,7 @@ 464 224 $DIN_LOC_ROOT/share/domains/domain.clm/domain.lnd.224x464_nldas_224x464_nldas.190403.nc $DIN_LOC_ROOT/share/domains/domain.clm/domain.ocn.224x464_nldas.190403.nc - Regional, 12km NLDAS grid over the U.S. + Regional NLDAS grid over the U.S. (roughly 12km resolution) From 82d1ef08bc8f2bf7d9e2e2897c6dc7068c41ec40 Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Thu, 4 Apr 2019 12:56:00 -0500 Subject: [PATCH 14/54] Add pnetcdf for intel+mvapich --- config/e3sm/machines/config_batch.xml | 2 +- config/e3sm/machines/config_machines.xml | 7 +++---- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/config/e3sm/machines/config_batch.xml b/config/e3sm/machines/config_batch.xml index a3e8a30fca14..fe3128b9b59b 100644 --- a/config/e3sm/machines/config_batch.xml +++ b/config/e3sm/machines/config_batch.xml @@ -278,7 +278,7 @@ - acme + acme diff --git a/config/e3sm/machines/config_machines.xml b/config/e3sm/machines/config_machines.xml index 6549a5a8a0a6..01c2756a5e79 100644 --- a/config/e3sm/machines/config_machines.xml +++ b/config/e3sm/machines/config_machines.xml @@ -1176,7 +1176,6 @@ mvapich2/2.3.1-verbs-dtbb6xk - openmpi/3.1.3-verbs-kqojjbw @@ -1221,9 +1220,9 @@ $SHELL{which nf-config | xargs dirname | xargs dirname} /lcrc/group/acme/soft/perl/5.26.0/bin:$ENV{PATH} - + + /blues/gpfs/home/software/climate/pnetcdf/1.8.1/intel-18.0.4/mvapich2-2.3.1-verbs + 1 0 From b2afe298e503ef14e75b04949aacebcd79e39422 Mon Sep 17 00:00:00 2001 From: jayeshkrishna Date: Thu, 4 Apr 2019 17:38:08 -0500 Subject: [PATCH 15/54] Suppress pio logs on non-component-root processes Fixing a bug that was introduced in PR #2799 (commit : 3eebd7fe90a87f8e824989bddbd63ad053239aad ). Making sure that we print out PIO logs only from rank 0 of each component. The old code printed out logs from all ranks in each component, resulting in large log files. Fixes #2839 --- src/share/util/shr_pio_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/share/util/shr_pio_mod.F90 b/src/share/util/shr_pio_mod.F90 index 855e715682bd..04461903423b 100644 --- a/src/share/util/shr_pio_mod.F90 +++ b/src/share/util/shr_pio_mod.F90 @@ -233,7 +233,7 @@ subroutine shr_pio_init2(comp_id, comp_name, comp_iamin, comp_comm, comp_comm_ia end do end if do i=1,total_comps - if(comp_iamin(i)) then + if(comp_iamin(i) .and. (comp_comm_iam(i) == 0)) then write(shr_log_unit,*) io_compname(i),' : pio_numiotasks = ',pio_comp_settings(i)%pio_numiotasks write(shr_log_unit,*) io_compname(i),' : pio_stride = ',pio_comp_settings(i)%pio_stride write(shr_log_unit,*) io_compname(i),' : pio_rearranger = ',pio_comp_settings(i)%pio_rearranger From f2707bdc3f2ebf24c927cd68140a68392cb18f23 Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Thu, 4 Apr 2019 18:27:32 -0500 Subject: [PATCH 16/54] Update cprnc --- config/e3sm/machines/config_machines.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config/e3sm/machines/config_machines.xml b/config/e3sm/machines/config_machines.xml index 01c2756a5e79..a1679810522b 100644 --- a/config/e3sm/machines/config_machines.xml +++ b/config/e3sm/machines/config_machines.xml @@ -1137,7 +1137,7 @@ /home/ccsm-data/inputdata/atm/datm7 /lcrc/group/acme/$USER/archive/$CASE /lcrc/group/acme/acme_baselines/$COMPILER - /home/ccsm-data/tools/cprnc + /lcrc/group/acme/tools/cprnc/cprnc 8 e3sm_integration slurm From 81ee26c7593035d99297d272258c2233ef8297a3 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 8 Apr 2019 10:39:44 -0600 Subject: [PATCH 17/54] Update nldas grid and mask names Based on discussion in Thursday's CTSM software meeting --- config/cesm/config_grids.xml | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/config/cesm/config_grids.xml b/config/cesm/config_grids.xml index 742563a69a2d..a26ea4eef8b4 100644 --- a/config/cesm/config_grids.xml +++ b/config/cesm/config_grids.xml @@ -120,11 +120,12 @@ null - - - 224x464_nldas - 224x464_nldas - 224x464_nldas + + + 0.125nldas2 + 0.125nldas2 + 0.125nldas2 null nldas @@ -1102,11 +1103,12 @@ 5x5 Amazon regional case -- only valid for DATM/CLM compset - + 464 224 - $DIN_LOC_ROOT/share/domains/domain.clm/domain.lnd.224x464_nldas_224x464_nldas.190403.nc - $DIN_LOC_ROOT/share/domains/domain.clm/domain.ocn.224x464_nldas.190403.nc - Regional NLDAS grid over the U.S. (roughly 12km resolution) + + $DIN_LOC_ROOT/share/domains/domain.clm/domain.lnd.224x464_nldas_224x464_nldas.190403.nc + $DIN_LOC_ROOT/share/domains/domain.clm/domain.ocn.224x464_nldas.190403.nc + Regional NLDAS-2 grid over the U.S. (0.125 degree resolution; 25-53N, 235-293E) From 753236e3553218a2f7acb440c2dc0e6a506a6156 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 8 Apr 2019 15:01:27 -0600 Subject: [PATCH 18/54] Update nldas mask info --- config/cesm/config_grids.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config/cesm/config_grids.xml b/config/cesm/config_grids.xml index a26ea4eef8b4..1ccce9f7be33 100644 --- a/config/cesm/config_grids.xml +++ b/config/cesm/config_grids.xml @@ -121,13 +121,13 @@ + 25-53N, 235-293E), with mask from NLDAS-2 atmospheric drivers --> 0.125nldas2 0.125nldas2 0.125nldas2 null - nldas + nldas2 From fb9cfe276c2b6318fdac4bf3a4682610ca22bb82 Mon Sep 17 00:00:00 2001 From: Patrick Worley Date: Wed, 10 Apr 2019 11:41:16 -0500 Subject: [PATCH 19/54] Update Anvil performance archiving support for switch to SLURM Anvil recently moved from PBS to SLURM. This requires changes to syslog.anvil and provenance.py to replace calls to PBS inquiry functions with calls to SLURM inquiry functions, to document job provenance and to capture job progress tracking data. [BFB] --- config/e3sm/machines/syslog.anvil | 71 ++++++++++++++++++++++++++----- scripts/lib/CIME/provenance.py | 23 +++++----- 2 files changed, 70 insertions(+), 24 deletions(-) diff --git a/config/e3sm/machines/syslog.anvil b/config/e3sm/machines/syslog.anvil index d387b975cf9b..c342495f20df 100755 --- a/config/e3sm/machines/syslog.anvil +++ b/config/e3sm/machines/syslog.anvil @@ -8,28 +8,54 @@ set lid = $3 set run = $4 set timing = $5 set dir = $6 -set ncores = 0 # Wait until job task-to-node mapping information is output before saving output file. # Target length was determined empirically (maximum number of lines before job mapping # information starts + number of nodes), and it may need to be adjusted in the future. # (Note that calling script 'touch'es the e3sm log file before spawning this script, so that 'wc' does not fail.) -set nnodes = `qstat -f $jid | grep -F Resource_List.nodes | sed 's/ *Resource_List.nodes = *\([0-9]*\):ppn=*\([0-9]*\) */\1/' ` -@ target_lines = 25 + $nnodes +set nnodes = `squeue --noheader -o '%D' --job $jid | sed 's/^0*\([0-9]*\)/\1/' ` +if ("X$nnodes" == "X") set nnodes = 0 +@ target_lines = 150 + $nnodes sleep 10 set outlth = `wc \-l $run/e3sm.log.$lid | sed 's/ *\([0-9]*\) *.*/\1/' ` while ($outlth < $target_lines) sleep 60 set outlth = `wc \-l $run/e3sm.log.$lid | sed 's/ *\([0-9]*\) *.*/\1/' ` end -set remaining = `qstat -f $jid | grep -F Walltime.Remaining | sed 's/ *Walltime.Remaining = *\([0-9]*\) */\1/' ` + +set TimeLeft = `squeue --noheader -O 'timeleft' --job $jid ` +set TimeLeftwday = `echo $TimeLeft | grep '-' ` +if ("X$TimeLeftwday" == "X") then + set left_days = 0 + set TimeLeftwhour = `echo $TimeLeft | grep '.*:.*:.*' ` + if ("X$TimeLeftwhour" == "X") then + set left_hours = 0 + set left_mins = `echo $TimeLeft | sed 's/^0*\([0-9]*\):0*\([0-9]*\)/\1/' ` + set left_secs = `echo $TimeLeft | sed 's/^0*\([0-9]*\):0*\([0-9]*\)/\2/' ` + else + set left_hours = `echo $TimeLeft | sed 's/^0*\([0-9]*\):0*\([0-9]*\):0*\([0-9]*\)/\1/' ` + set left_mins = `echo $TimeLeft | sed 's/^0*\([0-9]*\):0*\([0-9]*\):0*\([0-9]*\)/\2/' ` + set left_secs = `echo $TimeLeft | sed 's/^0*\([0-9]*\):0*\([0-9]*\):0*\([0-9]*\)/\3/' ` + endif +else + set left_days = `echo $TimeLeft | sed 's/^0*\([0-9]*\)-0*\([0-9]*\):0*\([0-9]*\):0*\([0-9]*\)/\1/' ` + set left_hours = `echo $TimeLeft | sed 's/^0*\([0-9]*\)-0*\([0-9]*\):0*\([0-9]*\):0*\([0-9]*\)/\2/' ` + set left_mins = `echo $TimeLeft | sed 's/^0*\([0-9]*\)-0*\([0-9]*\):0*\([0-9]*\):0*\([0-9]*\)/\3/' ` + set left_secs = `echo $TimeLeft | sed 's/^0*\([0-9]*\)-0*\([0-9]*\):0*\([0-9]*\):0*\([0-9]*\)/\4/' ` +endif + +if ("X$left_days" == "X") set left_days = 0 +if ("X$left_hours" == "X") set left_hours = 0 +if ("X$left_mins" == "X") set left_mins = 0 +if ("X$left_secs" == "X") set left_secs = 0 +@ remaining = 86400 * $left_days + 3600 * $left_hours + 60 * $left_mins + $left_secs cat > $run/Walltime.Remaining < $dir/qstatr.$lid.$remaining - qstat -1 -n acme > $dir/qstatn.$lid.$remaining + squeue -t R -o "%.10i %.10P %.15u %.20a %.2t %.6D %.8C %.12M %.12l %j" > $dir/squeuef.$lid.$remaining + squeue -s | grep -v -F extern > $dir/squeues.$lid.$remaining endif while ($remaining > 0) @@ -47,8 +73,8 @@ while ($remaining > 0) echo "Wallclock time remaining: $remaining" >> $dir/cpl.log.$lid.step tail -n 4 $dir/cpl.log.$lid.step-all >> $dir/cpl.log.$lid.step /bin/cp --preserve=timestamps -u $timing/* $dir - qstat -r acme > $dir/qstatr.$lid.$remaining - qstat -1 -n acme > $dir/qstatn.$lid.$remaining + squeue -t R -o "%.10i %.10P %.15u %.20a %.2t %.6D %.8C %.12M %.12l %j" > $dir/squeuef.$lid.$remaining + squeue -s | grep -v -F extern > $dir/squeues.$lid.$remaining chmod a+r $dir/* # sleep $sample_interval set sleep_remaining = $sample_interval @@ -57,11 +83,34 @@ while ($remaining > 0) @ sleep_remaining = $sleep_remaining - 120 end sleep $sleep_remaining - set remaining = `qstat -f $jid | grep -F Walltime.Remaining | sed 's/ *Walltime.Remaining = *\([0-9]*\) */\1/' ` - if ("X$remaining" == "X") set remaining = 0 + # query remaining time + set TimeLeft = `squeue --noheader -O 'timeleft' --job $jid ` + set TimeLeftwday = `echo $TimeLeft | grep '-' ` + if ("X$TimeLeftwday" == "X") then + set left_days = 0 + set TimeLeftwhour = `echo $TimeLeft | grep '.*:.*:.*' ` + if ("X$TimeLeftwhour" == "X") then + set left_hours = 0 + set left_mins = `echo $TimeLeft | sed 's/^0*\([0-9]*\):0*\([0-9]*\)/\1/' ` + set left_secs = `echo $TimeLeft | sed 's/^0*\([0-9]*\):0*\([0-9]*\)/\2/' ` + else + set left_hours = `echo $TimeLeft | sed 's/^0*\([0-9]*\):0*\([0-9]*\):0*\([0-9]*\)/\1/' ` + set left_mins = `echo $TimeLeft | sed 's/^0*\([0-9]*\):0*\([0-9]*\):0*\([0-9]*\)/\2/' ` + set left_secs = `echo $TimeLeft | sed 's/^0*\([0-9]*\):0*\([0-9]*\):0*\([0-9]*\)/\3/' ` + endif + else + set left_days = `echo $TimeLeft | sed 's/^0*\([0-9]*\)-0*\([0-9]*\):0*\([0-9]*\):0*\([0-9]*\)/\1/' ` + set left_hours = `echo $TimeLeft | sed 's/^0*\([0-9]*\)-0*\([0-9]*\):0*\([0-9]*\):0*\([0-9]*\)/\2/' ` + set left_mins = `echo $TimeLeft | sed 's/^0*\([0-9]*\)-0*\([0-9]*\):0*\([0-9]*\):0*\([0-9]*\)/\3/' ` + set left_secs = `echo $TimeLeft | sed 's/^0*\([0-9]*\)-0*\([0-9]*\):0*\([0-9]*\):0*\([0-9]*\)/\4/' ` + endif + if ("X$left_days" == "X") set left_days = 0 + if ("X$left_hours" == "X") set left_hours = 0 + if ("X$left_mins" == "X") set left_mins = 0 + if ("X$left_secs" == "X") set left_secs = 0 + @ remaining = 86400 * $left_days + 3600 * $left_hours + 60 * $left_mins + $left_secs cat > $run/Walltime.Remaining << EOF2 $remaining $sample_interval EOF2 end - diff --git a/scripts/lib/CIME/provenance.py b/scripts/lib/CIME/provenance.py index 742b456be9e7..8d80a73f8302 100644 --- a/scripts/lib/CIME/provenance.py +++ b/scripts/lib/CIME/provenance.py @@ -17,9 +17,9 @@ def _get_batch_job_id_for_syslog(case): """ mach = case.get_value("MACH") try: - if mach in ['anvil', 'titan']: + if mach in ['titan']: return os.environ["PBS_JOBID"] - elif mach in ['edison', 'cori-haswell', 'cori-knl']: + elif mach in ['anvil', 'edison', 'cori-haswell', 'cori-knl']: return os.environ["SLURM_JOB_ID"] elif mach in ['mira', 'theta']: return os.environ["COBALT_JOBID"] @@ -186,17 +186,14 @@ def _save_prerun_timing_e3sm(case, lid): full_cmd = cmd + " " + filename run_cmd_no_fail(full_cmd + "." + lid, from_dir=full_timing_dir) gzip_existing_file(os.path.join(full_timing_dir, filename + "." + lid)) - - # mdiag_reduce = os.path.join(full_timing_dir, "mdiag_reduce." + lid) - # run_cmd_no_fail("./mdiag_reduce.csh", arg_stdout=mdiag_reduce, from_dir=os.path.join(caseroot, "Tools")) - # gzip_existing_file(mdiag_reduce) elif mach == "anvil": - for cmd, filename in [("qstat -f -1 acme >", "qstatf"), - ("qstat -f %s >" % job_id, "qstatf_jobid"), - ("qstat -r acme >", "qstatr")]: - full_cmd = cmd + " " + filename - run_cmd_no_fail(full_cmd + "." + lid, from_dir=full_timing_dir) - gzip_existing_file(os.path.join(full_timing_dir, filename + "." + lid)) + for cmd, filename in [("sinfo -l", "sinfol"), + ("squeue -o '%all' --job {}".format(job_id), "squeueall_jobid"), + ("squeue -o '%.10i %.10P %.15u %.20a %.2t %.6D %.8C %.12M %.12l %.20S %.20V %j'", "squeuef"), + ("squeue -t R -o '%.10i %R'", "squeues")]: + filename = "%s.%s" % (filename, lid) + run_cmd_no_fail(cmd, arg_stdout=filename, from_dir=full_timing_dir) + gzip_existing_file(os.path.join(full_timing_dir, filename)) elif mach == "summit": for cmd, filename in [("bjobs -u all >", "bjobsu_all"), ("bjobs -r -u all -o 'jobid slots exec_host' >", "bjobsru_allo"), @@ -362,7 +359,7 @@ def _save_postrun_timing_e3sm(case, lid): if mach == "titan": globs_to_copy.append("%s*OU" % job_id) elif mach == "anvil": - globs_to_copy.append("/home/%s/%s*OU" % (getpass.getuser(), job_id)) + globs_to_copy.append("%s*run*%s" % (case.get_value("CASE"), job_id)) elif mach in ["mira", "theta"]: globs_to_copy.append("%s*error" % job_id) globs_to_copy.append("%s*output" % job_id) From 632ff0045cea4fdb5707a7f183feabe93739fbaf Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 10 Apr 2019 11:25:34 -0600 Subject: [PATCH 20/54] Point to updated domain files for nldas2 grid These: - Use a land mask based on the nldas2 atmospheric forcing data, covering more points than we had been using before (this mask includes lakes and some additional coastal points) - Use the new grid name --- config/cesm/config_grids.xml | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/config/cesm/config_grids.xml b/config/cesm/config_grids.xml index 1ccce9f7be33..15a6fc954532 100644 --- a/config/cesm/config_grids.xml +++ b/config/cesm/config_grids.xml @@ -1105,9 +1105,8 @@ 464 224 - - $DIN_LOC_ROOT/share/domains/domain.clm/domain.lnd.224x464_nldas_224x464_nldas.190403.nc - $DIN_LOC_ROOT/share/domains/domain.clm/domain.ocn.224x464_nldas.190403.nc + $DIN_LOC_ROOT/share/domains/domain.clm/domain.lnd.0.125nldas2_0.125nldas2.190410.nc + $DIN_LOC_ROOT/share/domains/domain.clm/domain.ocn.0.125nldas2.190410.nc Regional NLDAS-2 grid over the U.S. (0.125 degree resolution; 25-53N, 235-293E) From cf4b8eded37f17496dafcdb732972082e6ce07f0 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Wed, 10 Apr 2019 13:08:29 -0600 Subject: [PATCH 21/54] Update CIME to ESMCI cime5.8.1 (PR #2842) Update CIME to ESMCI cime5.8.1 Squash merge of jgfouca/branch-for-to-acme-2019-04-08 Features: * Support optional components by filling in stub models for any missing component class * cprnc: Make FIELDLIST message more informative * cprnc: allow differences in field lists for time-constant fields Bug fixes: * The check for an rpointer.drv file did not consider multidriver mode. * Fix ./case.build --clean * PET and ERP tests were not setting compile_threaded correctly. * Fixes inconsistency between MPASCICE and MPASSI, change all occurances of the former to the latter This is non-BFB for A cases due to: ESMCI/cime#3053 [non-BFB] --- config/cesm/config_files.xml | 8 +- config/cesm/config_grids.xml | 9 +- config/cesm/machines/config_compilers.xml | 60 +++++----- config/cesm/machines/config_machines.xml | 31 ++--- .../config_compilers.xml | 2 +- config/e3sm/allactive/config_compsets.xml | 88 +++++++------- config/e3sm/allactive/config_pesall.xml | 86 +++++++------- config/e3sm/config_archive.xml | 10 +- config/xml_schemas/config_machines.xsd | 2 + config/xml_schemas/env_mach_specific.xsd | 2 + scripts/Tools/Makefile | 14 ++- scripts/create_test | 6 + scripts/lib/CIME/BuildTools/configure.py | 5 +- scripts/lib/CIME/Servers/ftp.py | 2 - scripts/lib/CIME/Servers/wget.py | 2 - scripts/lib/CIME/XML/entry_id.py | 6 +- scripts/lib/CIME/XML/generic_xml.py | 2 +- scripts/lib/CIME/case/case.py | 109 ++++++++++++++++-- scripts/lib/CIME/case/case_submit.py | 9 +- scripts/lib/CIME/hist_utils.py | 4 +- src/build_scripts/buildlib.pio | 24 +++- .../datm/cime_config/config_component.xml | 1 + .../data_comps/datm/nuopc/datm_comp_mod.F90 | 2 +- .../desp/cime_config/config_component.xml | 2 +- .../mct/cime_config/config_component_e3sm.xml | 22 ++-- tools/cprnc/README | 20 +++- tools/cprnc/compare_vars_mod.F90.in | 41 +++---- tools/cprnc/cprnc.F90 | 98 +++++++++++++++- tools/cprnc/filestruct.F90 | 63 +++++++++- tools/cprnc/run_tests | 3 + tools/cprnc/test_inputs/README | 20 +++- ...pleTimes_someTimeless_extra_and_missing.nc | Bin 0 -> 1660 bytes .../test_inputs/noTime_extra_and_missing.nc | Bin 0 -> 952 bytes .../gen_domain_files/src/gen_domain.F90 | 12 +- 34 files changed, 533 insertions(+), 232 deletions(-) create mode 100644 tools/cprnc/test_inputs/multipleTimes_someTimeless_extra_and_missing.nc create mode 100644 tools/cprnc/test_inputs/noTime_extra_and_missing.nc diff --git a/config/cesm/config_files.xml b/config/cesm/config_files.xml index e11709e88f6b..5fd586014c05 100644 --- a/config/cesm/config_files.xml +++ b/config/cesm/config_files.xml @@ -2,7 +2,7 @@ - + char @@ -112,8 +112,8 @@ char - $CIMEROOT/src/drivers/$COMP_INTERFACE --> - --> + $CIMEROOT/src/drivers/$COMP_INTERFACE + case_comps env_case.xml Root directory of the case driver/coupler component @@ -229,7 +229,7 @@ char unset - $SRCROOT/cime_config/config_compsets.xml + $SRCROOT/cime_config/config_compsets.xml $COMP_ROOT_DIR_CPL/cime_config/config_compsets.xml $COMP_ROOT_DIR_ATM/cime_config/config_compsets.xml $COMP_ROOT_DIR_ATM/cime_config/config_compsets.xml diff --git a/config/cesm/config_grids.xml b/config/cesm/config_grids.xml index e06b7d52fa82..11d501bb4ba9 100644 --- a/config/cesm/config_grids.xml +++ b/config/cesm/config_grids.xml @@ -915,6 +915,13 @@ gx1v7 + + ne0np4CONUS.ne30x8 + ne0np4CONUS.ne30x8 + ne0np4CONUS.ne30x8 + gx1v7 + + ne0np4TESTONLY.ne5x4 ne0np4TESTONLY.ne5x4 @@ -1361,7 +1368,7 @@ 174098 1 $DIN_LOC_ROOT/share/domains/domain.lnd.ne0CONUSne30x8_gx1v7.190304.nc - $DIN_LOC_ROOT/share/domains/domain.ocn.ne0CONUSne30x8_gx1v7_190304.nc + $DIN_LOC_ROOT/share/domains/domain.ocn.ne0CONUSne30x8_gx1v7.190304.nc ne0np4CONUS.ne30x8 is a Spectral Elem 1-deg grid with a 1/8 deg refined region over the continental United States: Test support only diff --git a/config/cesm/machines/config_compilers.xml b/config/cesm/machines/config_compilers.xml index 1ca833f7e2dc..9e61d46eb7f6 100644 --- a/config/cesm/machines/config_compilers.xml +++ b/config/cesm/machines/config_compilers.xml @@ -87,7 +87,7 @@ using a fortran linker. - -h noomp + -h noomp -g -O0 -O2 @@ -102,7 +102,7 @@ using a fortran linker. -f free -N 255 -h byteswapio -x dir - -h noomp + -h noomp -g -O0 -K trap=fp -m1 -O2,ipa2 -em @@ -118,7 +118,7 @@ using a fortran linker. -std=gnu99 - -fopenmp + -fopenmp -g -Wall -Og -fbacktrace -ffpe-trap=invalid,zero,overflow -fcheck=bounds -O @@ -134,7 +134,7 @@ using a fortran linker. -fconvert=big-endian -ffree-line-length-none -ffixed-line-length-none - -fopenmp + -fopenmp -C=all -g -time -f2003 -ieee=stop - -gline + -gline -g -time -f2003 -ieee=stop - -gline + -gline -fixed @@ -325,7 +325,7 @@ using a fortran linker. -gopt -time - -mp + -mp @@ -361,7 +361,7 @@ using a fortran linker. -i4 -gopt -time -Mextend -byteswapio -Mflushz -Kieee - -mp + -mp -O0 -g -Ktrap=fp -Mbounds -Kieee -Mnovect -Mnovect @@ -372,7 +372,7 @@ using a fortran linker. -O0 -g -Ktrap=fp -Mbounds -Kieee - -mp + -mp -Mfixed @@ -389,7 +389,7 @@ using a fortran linker. FALSE -time -Wl,--allow-multiple-definition - -mp + -mp mpicc mpicxx @@ -432,8 +432,8 @@ using a fortran linker. -g -qfullpath -qmaxmem=-1 -qspillsize=2500 -qextname=flush -O3 -qstrict -qinline=auto - -qsmp=omp - -qsmp=omp:noopt + -qsmp=omp + -qsmp=omp:noopt -Wl,--relax -Wl,--allow-multiple-definition @@ -467,7 +467,7 @@ using a fortran linker. - -heap-arrays + -heap-arrays @@ -588,8 +588,8 @@ using a fortran linker. -DPIO_ENABLE_LOGGING=ON - $ENV{CESMDATAROOT}/tools/pFUnit/pFUnit3.2.8_cheyenne_Intel17.0.1_noMPI_noOpenMP - $ENV{CESMDATAROOT}/tools/pFUnit/pFUnit3.2.8_cheyenne_Intel17.0.1_MPI_openMP + $ENV{CESMDATAROOT}/tools/pFUnit/pFUnit3.2.8_cheyenne_Intel17.0.1_noMPI_noOpenMP + $ENV{CESMDATAROOT}/tools/pFUnit/pFUnit3.2.8_cheyenne_Intel17.0.1_MPI_openMP FALSE @@ -717,7 +717,7 @@ using a fortran linker. -O2 - -nomp + -nomp --host=Linux @@ -727,10 +727,10 @@ using a fortran linker. -O2 - -nomp + -nomp - -nomp + -nomp $ENV{NETCDF_HOME} lustre @@ -899,7 +899,7 @@ using a fortran linker. -mkl=cluster - /fs/cgd/csm/tools/pFUnit/pFUnit3.2.8_hobart_Intel15.0.2_noMPI_noOpenMP + /fs/cgd/csm/tools/pFUnit/pFUnit3.2.8_hobart_Intel15.0.2_noMPI_noOpenMP diff --git a/config/cesm/machines/config_machines.xml b/config/cesm/machines/config_machines.xml index 1bbf65d72836..10180ba10bb1 100644 --- a/config/cesm/machines/config_machines.xml +++ b/config/cesm/machines/config_machines.xml @@ -289,7 +289,7 @@ This allows using a different mpirun command to launch unit tests .*.cheyenne.ucar.edu - MPT: xmpi_net_accept_timeo/accept() timeout + MPT: Launcher network accept (MPI_LAUNCH_TIMEOUT) timed out 10 LINUX intel,gnu,pgi @@ -385,10 +385,16 @@ This allows using a different mpirun command to launch unit tests netcdf-mpi/4.6.1 pnetcdf/1.11.0 + + pio/2.4.1 + + + pio/1.10.1 + - mpt/2.15f - netcdf-mpi/4.5.0 - pnetcdf/1.9.0 + mpt/2.19 + netcdf-mpi/4.6.1 + pnetcdf/1.11.0 openmpi/3.0.1 @@ -415,7 +421,7 @@ This allows using a different mpirun command to launch unit tests - /glade/u/home/dunlap/ESMF-INSTALL/8.0.0bs29/lib/libg/Linux.intel.64.mpt.default/esmf.mk + /glade/u/home/turuncu/progs/esmf-8.0.0b29/install_dir/lib/libO/Linux.intel.64.mpt.default/esmf.mk ON SUMMARY /glade/work/dunlap/FV3GFS/benchmark-20181016/ @@ -645,10 +651,10 @@ This allows using a different mpirun command to launch unit tests /global/project/projectdirs/ccsm1/modulefiles/cori - esmf/6.3.0rp1-defio-intel2016-mpi-O + esmf/7.1.0r-defio-intel18.0.1.163-mpi-O-cori-haswell - esmf/6.3.0rp1-defio-intel2016-mpiuni-O + esmf/7.1.0r-netcdf-intel18.0.1.163-mpiuni-O-haswell @@ -661,8 +667,8 @@ This allows using a different mpirun command to launch unit tests cray-memkind - papi/5.5.1.3 - craype craype/2.5.12 + papi/5.6.0.3 + craype craype/2.5.15 cray-libsci/18.03.1 @@ -750,10 +756,7 @@ This allows using a different mpirun command to launch unit tests /global/project/projectdirs/ccsm1/modulefiles/cori - esmf/6.3.0rp1-defio-intel2016-mpi-O - - - esmf/6.3.0rp1-defio-intel2016-mpiuni-O + esmf/7.1.0r-defio-intel18.0.1.163-mpi-O-cori-knl @@ -767,7 +770,7 @@ This allows using a different mpirun command to launch unit tests cray-memkind craype-mic-knl - craype craype/2.5.14 + craype craype/2.5.15 cray-libsci/18.03.1 diff --git a/config/cesm/machines/userdefined_laptop_template/config_compilers.xml b/config/cesm/machines/userdefined_laptop_template/config_compilers.xml index 176bccde4899..ff654525eb0f 100644 --- a/config/cesm/machines/userdefined_laptop_template/config_compilers.xml +++ b/config/cesm/machines/userdefined_laptop_template/config_compilers.xml @@ -9,7 +9,7 @@ -DFORTRANUNDERSCORE -DNO_R16 - -fopenmp + -fopenmp /usr/local/bin/gfortran diff --git a/config/e3sm/allactive/config_compsets.xml b/config/e3sm/allactive/config_compsets.xml index b172cfa43c8f..118beecef09d 100644 --- a/config/e3sm/allactive/config_compsets.xml +++ b/config/e3sm/allactive/config_compsets.xml @@ -16,7 +16,7 @@ TIME = Time period (e.g. 2000, HIST, RCP8...) ATM = [CAM4, CAM5, SATM] LND = [CLM45, SLND] - ICE = [MPASCICE, CICE, DICE, SICE] + ICE = [MPASSI, CICE, DICE, SICE] OCN = [MPASO, DOCN, SOCN] ROF = [MOSART, SROF] GLC = [MALI, SGLC] @@ -41,217 +41,217 @@ A_WCYCL1850S_CMIP6 - 1850_CAM5%CMIP6_CLM45%SPBC_MPASCICE%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV + 1850_CAM5%CMIP6_CLM45%SPBC_MPASSI%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV A_WCYCL20TRS_CMIP6 - 20TR_CAM5%CMIP6_CLM45%SPBC_MPASCICE%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV + 20TR_CAM5%CMIP6_CLM45%SPBC_MPASSI%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV A_WCYCL1950S_CMIP6_LR - 1950_CAM5%CMIP6-LR_CLM45%SPBC_MPASCICE%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV + 1950_CAM5%CMIP6-LR_CLM45%SPBC_MPASSI%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV A_WCYCL1950S_CMIP6_HR - 1950_CAM5%CMIP6-HR_CLM45%SPBC_MPASCICE%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV + 1950_CAM5%CMIP6-HR_CLM45%SPBC_MPASSI%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV A_WCYCL1950S_CMIP6_LRtunedHR - 1950_CAM5%CMIP6-LRtunedHR_CLM45%SPBC_MPASCICE%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV + 1950_CAM5%CMIP6-LRtunedHR_CLM45%SPBC_MPASSI%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV A_WCYCL2000 - 2000_CAM5%AV1C-L_CLM45%SPBC_MPASCICE_MPASO_MOSART_SGLC_SWAV + 2000_CAM5%AV1C-L_CLM45%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV A_WCYCL2000S - 2000_CAM5%AV1C-L_CLM45%SPBC_MPASCICE%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV + 2000_CAM5%AV1C-L_CLM45%SPBC_MPASSI%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV A_WCYCL1850 - 1850_CAM5%AV1C-L_CLM45%SPBC_MPASCICE_MPASO_MOSART_SGLC_SWAV + 1850_CAM5%AV1C-L_CLM45%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV A_WCYCL1850S - 1850_CAM5%AV1C-L_CLM45%SPBC_MPASCICE%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV + 1850_CAM5%AV1C-L_CLM45%SPBC_MPASSI%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV A_WCYCL20TR - 20TR_CAM5%AV1C-L_CLM45%SPBC_MPASCICE_MPASO_MOSART_SGLC_SWAV + 20TR_CAM5%AV1C-L_CLM45%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV A_WCYCL20TRS - 20TR_CAM5%AV1C-L_CLM45%SPBC_MPASCICE%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV + 20TR_CAM5%AV1C-L_CLM45%SPBC_MPASSI%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV A_CRYO - 2000_CAM5%AV1C-L_CLM45%SPBC_MPASCICE_MPASO_MOSART_MALI_SWAV + 2000_CAM5%AV1C-L_CLM45%SPBC_MPASSI_MPASO_MOSART_MALI_SWAV A_WCYCL2000_H01A - 2000_CAM5%AV1C-H01A_CLM45%SPBC_MPASCICE_MPASO_MOSART_SGLC_SWAV + 2000_CAM5%AV1C-H01A_CLM45%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV A_WCYCL2000_H01AS - 2000_CAM5%AV1C-H01A_CLM45%SPBC_MPASCICE%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV + 2000_CAM5%AV1C-H01A_CLM45%SPBC_MPASSI%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV A_WCYCL1850_H01A - 1850_CAM5%AV1C-H01A_CLM45%SPBC_MPASCICE_MPASO_MOSART_SGLC_SWAV + 1850_CAM5%AV1C-H01A_CLM45%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV A_WCYCL1850_H01AS - 1850_CAM5%AV1C-H01A_CLM45%SPBC_MPASCICE%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV + 1850_CAM5%AV1C-H01A_CLM45%SPBC_MPASSI%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV A_WCYCL20TR_H01A - 20TR_CAM5%AV1C-H01A_CLM45%SPBC_MPASCICE_MPASO_MOSART_SGLC_SWAV + 20TR_CAM5%AV1C-H01A_CLM45%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV A_WCYCL20TR_H01AS - 20TR_CAM5%AV1C-H01A_CLM45%SPBC_MPASCICE%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV + 20TR_CAM5%AV1C-H01A_CLM45%SPBC_MPASSI%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV BGCEXP_BCRC_CNPRDCTC_1850 - 1850_CAM5%CMIP6_CLM45%CNPRDCTCBC_MPASCICE%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BCRC + 1850_CAM5%CMIP6_CLM45%CNPRDCTCBC_MPASSI%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BCRC BGCEXP_BCRC_CNPRDCTC_1850S - 1850_CAM5%CMIP6_CLM45%CNPRDCTCBC_MPASCICE%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV_BGC%BCRC + 1850_CAM5%CMIP6_CLM45%CNPRDCTCBC_MPASSI%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV_BGC%BCRC BGCEXP_BCRC_CNPRDCTC_20TR - 20TR_CAM5%CMIP6_CLM45%CNPRDCTCBC_MPASCICE%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BCRC + 20TR_CAM5%CMIP6_CLM45%CNPRDCTCBC_MPASSI%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BCRC BGCEXP_BCRC_CNPRDCTC_20TRS - 20TR_CAM5%CMIP6_CLM45%CNPRDCTCBC_MPASCICE%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV_BGC%BCRC + 20TR_CAM5%CMIP6_CLM45%CNPRDCTCBC_MPASSI%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV_BGC%BCRC BGCEXP_BCRD_CNPRDCTC_20TR - 20TR_CAM5%CMIP6_CLM45%CNPRDCTCBC_MPASCICE%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BCRD + 20TR_CAM5%CMIP6_CLM45%CNPRDCTCBC_MPASSI%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BCRD BGCEXP_BCRD_CNPRDCTC_20TRS - 20TR_CAM5%CMIP6_CLM45%CNPRDCTCBC_MPASCICE%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV_BGC%BCRD + 20TR_CAM5%CMIP6_CLM45%CNPRDCTCBC_MPASSI%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV_BGC%BCRD BGCEXP_BDRC_CNPRDCTC_20TR - 20TR_CAM5%CMIP6_CLM45%CNPRDCTCBC_MPASCICE%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BDRC + 20TR_CAM5%CMIP6_CLM45%CNPRDCTCBC_MPASSI%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BDRC BGCEXP_BDRC_CNPRDCTC_20TRS - 20TR_CAM5%CMIP6_CLM45%CNPRDCTCBC_MPASCICE%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV_BGC%BDRC + 20TR_CAM5%CMIP6_CLM45%CNPRDCTCBC_MPASSI%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV_BGC%BDRC BGCEXP_BDRD_CNPRDCTC_20TR - 20TR_CAM5%CMIP6_CLM45%CNPRDCTCBC_MPASCICE%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BDRD + 20TR_CAM5%CMIP6_CLM45%CNPRDCTCBC_MPASSI%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BDRD BGCEXP_BDRD_CNPRDCTC_20TRS - 20TR_CAM5%CMIP6_CLM45%CNPRDCTCBC_MPASCICE%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV_BGC%BDRD + 20TR_CAM5%CMIP6_CLM45%CNPRDCTCBC_MPASSI%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV_BGC%BDRD BGCEXP_BCRC_CNPECACNT_1850 - 1850_CAM5%CMIP6_CLM45%CNPECACNTBC_MPASCICE%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BCRC + 1850_CAM5%CMIP6_CLM45%CNPECACNTBC_MPASSI%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BCRC BGCEXP_BCRC_CNPECACNT_20TR - 20TR_CAM5%CMIP6_CLM45%CNPECACNTBC_MPASCICE%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BCRC + 20TR_CAM5%CMIP6_CLM45%CNPECACNTBC_MPASSI%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BCRC BGCEXP_BCRD_CNPECACNT_20TR - 20TR_CAM5%CMIP6_CLM45%CNPECACNTBC_MPASCICE%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BCRD + 20TR_CAM5%CMIP6_CLM45%CNPECACNTBC_MPASSI%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BCRD BGCEXP_BDRC_CNPECACNT_20TR - 20TR_CAM5%CMIP6_CLM45%CNPECACNTBC_MPASCICE%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BDRC + 20TR_CAM5%CMIP6_CLM45%CNPECACNTBC_MPASSI%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BDRC BGCEXP_BDRD_CNPECACNT_20TR - 20TR_CAM5%CMIP6_CLM45%CNPECACNTBC_MPASCICE%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BDRD + 20TR_CAM5%CMIP6_CLM45%CNPECACNTBC_MPASSI%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BDRD A_WCYCL1850-DIB - 1850_CAM5%AV1C-L_CLM45%SPBC_MPASCICE%DIB_MPASO%IB_MOSART_SGLC_SWAV + 1850_CAM5%AV1C-L_CLM45%SPBC_MPASSI%DIB_MPASO%IB_MOSART_SGLC_SWAV A_WCYCL1850-DIB-ISMF - 1850_CAM5%AV1C-L_CLM45%SPBC_MPASCICE%DIB_MPASO%IBISMF_MOSART_SGLC_SWAV + 1850_CAM5%AV1C-L_CLM45%SPBC_MPASSI%DIB_MPASO%IBISMF_MOSART_SGLC_SWAV A_WCYCL1850-DIB_CMIP6 - 1850_CAM5%CMIP6_CLM45%SPBC_MPASCICE%DIB_MPASO%IB_MOSART_SGLC_SWAV + 1850_CAM5%CMIP6_CLM45%SPBC_MPASSI%DIB_MPASO%IB_MOSART_SGLC_SWAV A_WCYCL1850-DIB-ISMF_CMIP6 - 1850_CAM5%CMIP6_CLM45%SPBC_MPASCICE%DIB_MPASO%IBISMF_MOSART_SGLC_SWAV + 1850_CAM5%CMIP6_CLM45%SPBC_MPASSI%DIB_MPASO%IBISMF_MOSART_SGLC_SWAV A_WCYCL1850_v0atm - 1850_CAM5_CLM45%SP_MPASCICE_MPASO_MOSART_SGLC_SWAV + 1850_CAM5_CLM45%SP_MPASSI_MPASO_MOSART_SGLC_SWAV A_WCYCL2000_v0atm - 2000_CAM5_CLM45%SP_MPASCICE_MPASO_MOSART_SGLC_SWAVi + 2000_CAM5_CLM45%SP_MPASSI_MPASO_MOSART_SGLC_SWAVi A_WCYCL1850S_v0atm - 1850_CAM5_CLM45%SP_MPASCICE%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV + 1850_CAM5_CLM45%SP_MPASSI%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAV A_WCYCL2000S_v0atm - 2000_CAM5_CLM45%SP_MPASCICE%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAVi + 2000_CAM5_CLM45%SP_MPASSI%SPUNUP_MPASO%SPUNUP_MOSART_SGLC_SWAVi @@ -259,13 +259,13 @@ A_BG1850CN - 1850_CAM5_CLM45%CN_MPASCICE_MPASO_MOSART_MALI%SIA_SWAV + 1850_CAM5_CLM45%CN_MPASSI_MPASO_MOSART_MALI%SIA_SWAV MPAS_LISIO_TEST - 2000_DATM%NYF_SLND_MPASCICE_MPASO_DROF%NYF_MALI%SIA_SWAV + 2000_DATM%NYF_SLND_MPASSI_MPASO_DROF%NYF_MALI%SIA_SWAV diff --git a/config/e3sm/allactive/config_pesall.xml b/config/e3sm/allactive/config_pesall.xml index 86739a4f92dc..86d173bd0dc8 100644 --- a/config/e3sm/allactive/config_pesall.xml +++ b/config/e3sm/allactive/config_pesall.xml @@ -6030,7 +6030,7 @@ - + "133 node version gets 6 SYPD. This will be the default and M size" 2700 @@ -6067,7 +6067,7 @@ - + "39 node version gets 2.1 SYPD." 675 @@ -6104,7 +6104,7 @@ - + "285 node version gets 11.5 SYPD" 5400 @@ -6141,7 +6141,7 @@ - + "185 nodes, 32x1, ~5sypd (wmod185)" 5400 @@ -6174,7 +6174,7 @@ 0 - + "15 nodes, 32x1, ~.5sypd (wmod015)" 288 @@ -6211,7 +6211,7 @@ - + "cori-knl ne30 coupled compest on 120 nodes, 64x1 (2 threads CPL/OCN/ICE), (kmod125) sypd=4.1" 64 128 @@ -6246,7 +6246,7 @@ 0 - + "cori-knl ne30 coupled compest on 60 nodes, 67x2, (kmod060b) sypd=2.86" 67 268 @@ -6281,7 +6281,7 @@ 0 - + "cori-knl ne30 coupled compest on 31 nodes, 67x2, (kmod031b) sypd=1.71" 67 134 @@ -6316,7 +6316,7 @@ 0 - + "cori-knl ne30 coupled compest on 17 nodes, 67x4, (kmod017) sypd=1.12" 67 268 @@ -6455,7 +6455,7 @@ - + none 675 @@ -6492,7 +6492,7 @@ - + none 1024 @@ -6566,7 +6566,7 @@ - + none 9600 @@ -6603,7 +6603,7 @@ - + none 9600 @@ -6640,7 +6640,7 @@ - + ne120 coupled-compset on 1024 nodes 2700 @@ -6673,7 +6673,7 @@ 0 - + ne120 coupled-compset on 2048 nodes 5400 @@ -6706,7 +6706,7 @@ 0 - + ne120 coupled-compset on 4096 nodes 10800 @@ -6916,7 +6916,7 @@ 0 - + ne120-wcycl on 145 nodes, MPI-only 64 64 @@ -6951,7 +6951,7 @@ 0 - + ne120-wcycl on 145 nodes, threaded 256 64 @@ -6986,7 +6986,7 @@ 0 - + ne120 coupled-compset on 466 nodes 64 64 @@ -7021,7 +7021,7 @@ 0 - + ne120-wcycl on 863 nodes, MPI-only 64 64 @@ -7056,7 +7056,7 @@ 0 - + ne120-wcycl on 863 nodes, threaded 128 64 @@ -7091,7 +7091,7 @@ 0 - + ne120-wcycl on 825 nodes, threaded, 32 tasks/node 128 32 @@ -7126,7 +7126,7 @@ 0 - + ne120-wcycl on 800 nodes, threaded, 32 tasks/node 128 32 @@ -7163,7 +7163,7 @@ - + cori-knl ne120 coupled compset on 1025 nodes, 33x8, (hmod1025vc) s=1.0 33 264 @@ -7198,7 +7198,7 @@ 0 - + cori-knl ne120 coupled-compset on 448 nodes, 33x8, (hmod448b) sypd=0.69 wcosplite s=0.54 33 264 @@ -7233,7 +7233,7 @@ 0 - + cori-knl ne120 coupled-compset on 207 nodes, 33x8, (hmod207) sypd=0.37 33 264 @@ -7268,7 +7268,7 @@ 0 - + cori-knl ne120 coupled-compset on 131 nodes, 33x8, (hmod131) sypd=0.25 33 264 @@ -7506,7 +7506,7 @@ - + -compset A_WCYCL* -res ne30_oEC* on 32 nodes pure-MPI 675 @@ -7539,7 +7539,7 @@ 0 - + -compset A_WCYCL* -res ne30_oEC* on 54 nodes pure-MPI 1350 @@ -7572,7 +7572,7 @@ 0 - + -compset A_WCYCL* -res ne30_oEC* on 105 nodes pure-MPI 2700 @@ -7607,7 +7607,7 @@ - + ne30-wcycl on 8 nodes 128 64 @@ -7642,7 +7642,7 @@ 0 - + ne30-wcycl on 128 nodes 128 64 @@ -7817,7 +7817,7 @@ 0 - + none 96 @@ -7850,7 +7850,7 @@ 0 - + none 96 @@ -7988,7 +7988,7 @@ - + "cori-knl ne4 coupled compest on 6 nodes, sypd=22.9" 67 134 @@ -8075,7 +8075,7 @@ - + "edison ne4 coupled compest on 6 nodes, OCN by itself on 2 nodes sypd=45.2" 96 @@ -8135,7 +8135,7 @@ - + 30to10-gmpas on 128 nodes 128 64 @@ -8172,7 +8172,7 @@ - + cori-knl G 30to10 on 52 nodes, 64x2 64 128 @@ -8209,7 +8209,7 @@ - + cori-haswell G 30to10 on 48 nodes 512 @@ -8244,7 +8244,7 @@ - + cori-knl G 30to10 on 128 nodes 1024 @@ -8279,7 +8279,7 @@ - + 30to10-gmpas on 32 nodes 16 16 @@ -8390,7 +8390,7 @@ - + cori-knl, hires (18to6) G case on 150 nodes, 64x2, sypd=0.5 64 128 @@ -8419,7 +8419,7 @@ - + cori-knl, lowres (60to30) G case on 16 nodes, 64x2, sypd=2.42 64 128 diff --git a/config/e3sm/config_archive.xml b/config/e3sm/config_archive.xml index 9832355e6f10..afe05a45aa0d 100644 --- a/config/e3sm/config_archive.xml +++ b/config/e3sm/config_archive.xml @@ -74,7 +74,7 @@ - + rst rst.am.timeSeriesStatsMonthly hist @@ -85,10 +85,10 @@ rpointer.ice - mpascice.rst.1976-01-01_00000.nc - mpascice.rst.am.timeSeriesStatsMonthly.1976-01-01_00000.nc - mpascice.hist.1976-01-01_00000.nc - mpascice.hist.am.regionalStatistics.0001.01.nc + mpassi.rst.1976-01-01_00000.nc + mpassi.rst.am.timeSeriesStatsMonthly.1976-01-01_00000.nc + mpassi.hist.1976-01-01_00000.nc + mpassi.hist.am.regionalStatistics.0001.01.nc diff --git a/config/xml_schemas/config_machines.xsd b/config/xml_schemas/config_machines.xsd index c12972a466fc..c4d189cb1602 100644 --- a/config/xml_schemas/config_machines.xsd +++ b/config/xml_schemas/config_machines.xsd @@ -8,6 +8,7 @@ + @@ -222,6 +223,7 @@ + diff --git a/config/xml_schemas/env_mach_specific.xsd b/config/xml_schemas/env_mach_specific.xsd index 7dc8b01b8ee9..251eae546ea8 100644 --- a/config/xml_schemas/env_mach_specific.xsd +++ b/config/xml_schemas/env_mach_specific.xsd @@ -6,6 +6,7 @@ + @@ -98,6 +99,7 @@ + diff --git a/scripts/Tools/Makefile b/scripts/Tools/Makefile index 7f9a30bcd57b..aaf7e8bb1b64 100644 --- a/scripts/Tools/Makefile +++ b/scripts/Tools/Makefile @@ -72,9 +72,6 @@ endif ifeq ($(strip $(USE_KOKKOS)), TRUE) USE_CXX = TRUE endif -ifeq ($(strip $(USE_KOKKOS)), TRUE) - USE_CXX = TRUE -endif ifeq ($(strip $(USE_FMS)), TRUE) SLIBS += -lfms @@ -488,9 +485,16 @@ ifndef MCT_LIBDIR MCT_LIBDIR=$(INSTALL_SHAREDPATH)/lib endif -ifndef PIO_LIBDIR - PIO_LIBDIR=$(INSTALL_SHAREDPATH)/lib +ifdef PIO_LIBDIR + ifeq ($(PIO_VERSION),$(PIO_VERSION_MAJOR)) + INCLDIR += -I$(PIO_INCDIR) + SLIBS += -L$(PIO_LIBDIR) + else + # If PIO_VERSION_MAJOR doesnt match, build from source + unexport PIO_LIBDIR + endif endif +PIO_LIBDIR ?= $(INSTALL_SHAREDPATH)/lib ifndef GPTL_LIBDIR GPTL_LIBDIR=$(INSTALL_SHAREDPATH)/lib diff --git a/scripts/create_test b/scripts/create_test index f22790e47b0d..2bcd5bae1ae6 100755 --- a/scripts/create_test +++ b/scripts/create_test @@ -404,6 +404,12 @@ def parse_command_line(args, description): args.compiler = mach_obj.get_default_compiler() if args.compiler is None else args.compiler test_names = get_tests.get_full_test_names(args.testargs, mach_obj.get_machine_name(), args.compiler) + if len(args.testargs) == 1 and \ + args.testargs[0] in get_tests.get_test_suites() and \ + get_tests.get_test_data(args.testargs[0])[2] and \ + not args.single_exe: + logging.info("Suite supports shared executables, setting --single-exe to True") + args.single_exe = True if len(args.testargs) == 1 and \ args.testargs[0] in get_tests.get_test_suites() and \ diff --git a/scripts/lib/CIME/BuildTools/configure.py b/scripts/lib/CIME/BuildTools/configure.py index 0d5b766c0154..e223356616e2 100644 --- a/scripts/lib/CIME/BuildTools/configure.py +++ b/scripts/lib/CIME/BuildTools/configure.py @@ -68,7 +68,10 @@ def _copy_depends_files(machine_name, machines_dir, output_dir, compiler): class FakeCase(object): def __init__(self, compiler, mpilib, debug, comp_interface): - self._vals = {"COMPILER":compiler, "MPILIB":mpilib, "DEBUG":debug, "COMP_INTERFACE":comp_interface} + # PIO_VERSION is needed to parse config_machines.xml but isn't otherwise used + # by FakeCase + self._vals = {"COMPILER":compiler, "MPILIB":mpilib, "DEBUG":debug, + "COMP_INTERFACE":comp_interface, "PIO_VERSION":2} def get_value(self, attrib): expect(attrib in self._vals, "FakeCase does not support getting value of '%s'" % attrib) diff --git a/scripts/lib/CIME/Servers/ftp.py b/scripts/lib/CIME/Servers/ftp.py index 0fbae9fa606e..21aa5207692a 100644 --- a/scripts/lib/CIME/Servers/ftp.py +++ b/scripts/lib/CIME/Servers/ftp.py @@ -22,8 +22,6 @@ def __init__(self, address, user='', passwd=''): self._ftp_server = address - self._ftp_server = address - stat = self.ftp.login(user, passwd) logger.debug("login stat {}".format(stat)) if "Login successful" not in stat: diff --git a/scripts/lib/CIME/Servers/wget.py b/scripts/lib/CIME/Servers/wget.py index 7ac45aa211f4..eb6857918845 100644 --- a/scripts/lib/CIME/Servers/wget.py +++ b/scripts/lib/CIME/Servers/wget.py @@ -15,8 +15,6 @@ def __init__(self, address, user='', passwd=''): self._args += "--password {} ".format(passwd) self._server_loc = address - self._server_loc = address - err = run_cmd("wget {} --spider {}".format(self._args, address))[0] expect(err == 0,"Could not connect to repo '{0}'\nThis is most likely either a proxy, or network issue .") diff --git a/scripts/lib/CIME/XML/entry_id.py b/scripts/lib/CIME/XML/entry_id.py index 38c18a93e2bf..d02e88680bba 100644 --- a/scripts/lib/CIME/XML/entry_id.py +++ b/scripts/lib/CIME/XML/entry_id.py @@ -184,8 +184,8 @@ def get_valid_values(self, vid): def _get_valid_values(self, node): valid_values = self.get_element_text("valid_values", root=node) - valid_values_list = None - if valid_values is not None: + valid_values_list = [] + if valid_values: valid_values_list = [item.lstrip() for item in valid_values.split(',')] return valid_values_list @@ -234,7 +234,7 @@ def get_valid_value_string(self, node, value,vid=None, ignore_type=False): type_str = self._get_type_info(node) str_value = convert_to_string(value, type_str, vid) - if valid_values is not None and not str_value.startswith('$'): + if valid_values and not str_value.startswith('$'): expect(str_value in valid_values, "Did not find {} in valid values for {}: {}".format(value, vid, valid_values)) return str_value diff --git a/scripts/lib/CIME/XML/generic_xml.py b/scripts/lib/CIME/XML/generic_xml.py index de962e20dfd6..26b82199933d 100644 --- a/scripts/lib/CIME/XML/generic_xml.py +++ b/scripts/lib/CIME/XML/generic_xml.py @@ -300,7 +300,7 @@ def set_element_text(self, element_name, new_text, attributes=None, root=None): return None def to_string(self, node, method="xml", encoding="us-ascii"): - return ET.tostring(node, method=method, encoding=encoding) + return ET.tostring(node.xml_element, method=method, encoding=encoding) # # API for operations over the entire file diff --git a/scripts/lib/CIME/case/case.py b/scripts/lib/CIME/case/case.py index 0dd0795ec7dd..220a554bb455 100644 --- a/scripts/lib/CIME/case/case.py +++ b/scripts/lib/CIME/case/case.py @@ -464,16 +464,19 @@ def _set_compset(self, compset_name, files, driver="mct"): self._compsetname = match logger.info("Compset longname is {}".format(match)) logger.info("Compset specification file is {}".format(compsets_filename)) - return compset_alias, science_support + break if compset_alias is None: logger.info("Did not find an alias or longname compset match for {} ".format(compset_name)) self._compsetname = compset_name - # if this is a valiid compset longname there will be at least 7 components. - components = self.get_compset_components() - expect(len(components) > 6, "No compset alias {} found and this does not appear to be a compset longname.".format(compset_name)) - return None, science_support + # Fill in compset name + self._compsetname, self._components = self.valid_compset(self._compsetname, files) + # if this is a valiid compset longname there will be at least 7 components. + components = self.get_compset_components() + expect(len(components) > 6, "No compset alias {} found and this does not appear to be a compset longname.".format(compset_name)) + + return compset_alias, science_support def get_primary_component(self): if self._primary_component is None: @@ -529,6 +532,96 @@ def _find_primary_component(self): return primary_component + def _valid_compset_impl(self, compset_name, comp_classes, comp_hash): + """Add stub models missing in , return full compset name. + is a list of all supported component classes. + is a dictionary where each key is a supported component + (e.g., datm) and the associated value is the index in of + that component's class (e.g., 1 for atm). + >>> Case(read_only=False)._valid_compset_impl('2000_DATM%NYF_SLND_DICE%SSMI_DOCN%DOM_DROF%NYF_SGLC_SWAV', ['CPL', 'ATM', 'LND', 'ICE', 'OCN', 'ROF', 'GLC', 'WAV', 'ESP'], {'datm':1,'satm':1,'dlnd':2,'slnd':2,'dice':3,'sice':3,'docn':4,'socn':4,'drof':5,'srof':5,'sglc':6,'swav':7,'ww3':7,'sesp':8}) + ('2000_DATM%NYF_SLND_DICE%SSMI_DOCN%DOM_DROF%NYF_SGLC_SWAV_SESP', ['2000', 'DATM%NYF', 'SLND', 'DICE%SSMI', 'DOCN%DOM', 'DROF%NYF', 'SGLC', 'SWAV', 'SESP']) + >>> Case(read_only=False)._valid_compset_impl('2000_DATM%NYF_DICE%SSMI_DOCN%DOM_DROF%NYF', ['CPL', 'ATM', 'LND', 'ICE', 'OCN', 'ROF', 'GLC', 'WAV', 'ESP'], {'datm':1,'satm':1,'dlnd':2,'slnd':2,'dice':3,'sice':3,'docn':4,'socn':4,'drof':5,'srof':5,'sglc':6,'swav':7,'ww3':7,'sesp':8}) + ('2000_DATM%NYF_SLND_DICE%SSMI_DOCN%DOM_DROF%NYF_SGLC_SWAV_SESP', ['2000', 'DATM%NYF', 'SLND', 'DICE%SSMI', 'DOCN%DOM', 'DROF%NYF', 'SGLC', 'SWAV', 'SESP']) + >>> Case(read_only=False)._valid_compset_impl('2000_DICE%SSMI_DOCN%DOM_DATM%NYF_DROF%NYF', ['CPL', 'ATM', 'LND', 'ICE', 'OCN', 'ROF', 'GLC', 'WAV', 'ESP'], {'datm':1,'satm':1,'dlnd':2,'slnd':2,'dice':3,'sice':3,'docn':4,'socn':4,'drof':5,'srof':5,'sglc':6,'swav':7,'ww3':7,'sesp':8}) + ('2000_DATM%NYF_SLND_DICE%SSMI_DOCN%DOM_DROF%NYF_SGLC_SWAV_SESP', ['2000', 'DATM%NYF', 'SLND', 'DICE%SSMI', 'DOCN%DOM', 'DROF%NYF', 'SGLC', 'SWAV', 'SESP']) + >>> Case(read_only=False)._valid_compset_impl('1850_CAM60_CLM50%BGC-CROP_CICE_POP2%ECO%ABIO-DIC_MOSART_CISM2%NOEVOLVE_WW3_BGC%BDRD', ['CPL', 'ATM', 'LND', 'ICE', 'OCN', 'ROF', 'GLC', 'WAV', 'ESP'], {'datm':1,'satm':1, 'cam':1,'dlnd':2,'clm':2,'slnd':2,'cice':3,'dice':3,'sice':3,'pop':4,'docn':4,'socn':4,'mosart':5,'drof':5,'srof':5,'cism':6,'sglc':6,'ww':7,'swav':7,'ww3':7,'sesp':8}) + ('1850_CAM60_CLM50%BGC-CROP_CICE_POP2%ECO%ABIO-DIC_MOSART_CISM2%NOEVOLVE_WW3_SESP_BGC%BDRD', ['1850', 'CAM60', 'CLM50%BGC-CROP', 'CICE', 'POP2%ECO%ABIO-DIC', 'MOSART', 'CISM2%NOEVOLVE', 'WW3', 'SESP', 'BGC%BDRD']) + """ + # Find the models declared in the compset + model_set = [None]*len(comp_classes) + components = compset_name.split('_') + model_set[0] = components[0] + # Check for BGC + if components[-1][0:3] == 'BGC': + bgc = components[-1] + last_ind = len(components) - 1 + else: + bgc = None + last_ind = len(components) + + for model in components[1:last_ind]: + match = Case.__mod_match_re__.match(model.lower()) + expect(match is not None, "No model match for {}".format(model)) + mod_match = match.group(1) + expect(mod_match in comp_hash, + "Unknown model type, {}".format(model)) + comp_ind = comp_hash[mod_match] + model_set[comp_ind] = model + + # Fill in missing components with stubs + for comp_ind in range(1, len(model_set)): + if model_set[comp_ind] is None: + comp_class = comp_classes[comp_ind] + stub = 'S' + comp_class + logger.info("Automatically adding {} to compset".format(stub)) + model_set[comp_ind] = stub + + # Return the completed compset + if bgc is not None: + model_set.append(bgc) + + compsetname = '_'.join(model_set) + return compsetname, model_set + + # RE to match component type name without optional piece (stuff after %). + # Drop any trailing digits (e.g., the 60 in CAM60) to ensure match + # Note, this will also drop trailing digits such as in ww3 but since it + # is handled consistenly, this should not affect functionality. + # Note: interstitial digits are included (e.g., in FV3GFS). + __mod_match_re__ = re.compile(r"([^%]*[^0-9%]+)") + def valid_compset(self, compset_name, files): + """Add stub models missing in , return full compset name. + is used to collect set of all supported components. + """ + # First, create hash of model names + # A note about indexing. Relevant component classes start at 1 + # because we ignore CPL for finding model components. + # Model components would normally start at zero but since we are + # dealing with a compset, 0 is reserved for the time field + drv_config_file = files.get_value("CONFIG_CPL_FILE") + drv_comp = Component(drv_config_file, "CPL") + comp_classes = drv_comp.get_valid_model_components() + comp_hash = {} # Hash model name to component class index + for comp_ind in range(1, len(comp_classes)): + comp = comp_classes[comp_ind] + # Find list of models for component class + # List can be in different locations, check CONFIG_XXX_FILE + node_name = 'CONFIG_{}_FILE'.format(comp) + models = files.get_components(node_name) + if (models is None) or (None in models): + # Backup, check COMP_ROOT_DIR_XXX + node_name = 'COMP_ROOT_DIR_' + comp + models = files.get_components(node_name) + + expect((models is not None) and (None not in models), + "Unable to find list of supported components") + + for model in models: + mod_match = Case.__mod_match_re__.match(model.lower()).group(1) + comp_hash[mod_match] = comp_ind + + return self._valid_compset_impl(compset_name, comp_classes, comp_hash) + def _set_info_from_primary_component(self, files, pesfile=None): """ @@ -633,9 +726,6 @@ def _get_component_config_data(self, files, driver=None): # for each component self.set_comp_classes(drv_comp.get_valid_model_components()) - if len(self._component_classes) > len(self._components): - self._components.append('sesp') - # will need a change here for new cpl components root_dir_node_name = 'COMP_ROOT_DIR_CPL' comp_root_dir = files.get_value(root_dir_node_name, {"component":driver}, resolved=False) @@ -788,6 +878,9 @@ def configure(self, compset_name, grid_name, machine_name=None, #-------------------------------------------- files = Files(comp_interface=driver) + #-------------------------------------------- + # find and/or fill out compset name + #-------------------------------------------- compset_alias, science_support = self._set_compset(compset_name, files, driver) self._components = self.get_compset_components() diff --git a/scripts/lib/CIME/case/case_submit.py b/scripts/lib/CIME/case/case_submit.py index 4f40520580c9..180d4f1dfd91 100644 --- a/scripts/lib/CIME/case/case_submit.py +++ b/scripts/lib/CIME/case/case_submit.py @@ -34,11 +34,16 @@ def _submit(case, job=None, no_batch=False, prereq=None, allow_fail=False, resub rundir = case.get_value("RUNDIR") expect(os.path.isdir(rundir), "CONTINUE_RUN is true but RUNDIR {} does not exist".format(rundir)) - expect(os.path.exists(os.path.join(rundir,"rpointer.drv")), + # only checks for the first instance in a multidriver case + if case.get_value("MULTI_DRIVER"): + rpointer = "rpointer.drv_0001" + else: + rpointer = "rpointer.drv" + expect(os.path.exists(os.path.join(rundir,rpointer)), "CONTINUE_RUN is true but this case does not appear to have restart files staged in {}".format(rundir)) # Finally we open the rpointer.drv file and check that it's correct casename = case.get_value("CASE") - with open(os.path.join(rundir,"rpointer.drv"), "r") as fd: + with open(os.path.join(rundir,rpointer), "r") as fd: ncfile = fd.readline().strip() expect(ncfile.startswith(casename) and os.path.exists(os.path.join(rundir,ncfile)), diff --git a/scripts/lib/CIME/hist_utils.py b/scripts/lib/CIME/hist_utils.py index e13412f78df8..fdc3c280da56 100644 --- a/scripts/lib/CIME/hist_utils.py +++ b/scripts/lib/CIME/hist_utils.py @@ -584,7 +584,7 @@ def get_ts_synopsis(comments): >>> get_ts_synopsis('big error\n') 'big error' >>> get_ts_synopsis('stuff\n File foo had a different field list from bar with suffix baz\nPass\n') - 'FIELDLIST field lists differ' + 'FIELDLIST field lists differ (otherwise bit-for-bit)' >>> get_ts_synopsis('stuff\n File foo had no compare counterpart in bar with suffix baz\nPass\n') 'ERROR BFAIL some baseline files were missing' >>> get_ts_synopsis('stuff\n File foo had a different field list from bar with suffix baz\n File foo had no compare counterpart in bar with suffix baz\nPass\n') @@ -631,7 +631,7 @@ def get_ts_synopsis(comments): # line, which we don't want. return "MULTIPLE ISSUES: field lists differ and some baseline files were missing" elif has_fieldlist_differences: - return "FIELDLIST field lists differ" + return "FIELDLIST field lists differ (otherwise bit-for-bit)" elif has_bfails: return "ERROR {} some baseline files were missing".format(TEST_NO_BASELINES_COMMENT) else: diff --git a/src/build_scripts/buildlib.pio b/src/build_scripts/buildlib.pio index 8a197e0c2f37..b93f9547a3a2 100755 --- a/src/build_scripts/buildlib.pio +++ b/src/build_scripts/buildlib.pio @@ -47,6 +47,19 @@ def buildlib(bldroot, installpath, case): ############################################################################### caseroot = case.get_value("CASEROOT") pio_version = case.get_value("PIO_VERSION") + # If variable PIO_VERSION_MAJOR is defined in the environment then + # we assume that PIO is installed on the system + # and expect to find + # PIO_LIBDIR, PIO_INCDIR, PIO_TYPENAME_VALID_VALUES + # also defined in the environment. In this case we + # will use the installed pio and not build it here. + installed_pio_version = os.environ.get("PIO_VERSION_MAJOR") + logger.info("pio_version_major = {} pio_version = {}".format(installed_pio_version, pio_version)) + if installed_pio_version is not None and int(installed_pio_version) == pio_version: + logger.info("Using installed PIO library") + _set_pio_valid_values(case, os.environ.get("PIO_TYPENAME_VALID_VALUES")) + return + pio_model = "pio{}".format(pio_version) pio_dir = os.path.join(bldroot, pio_model) if not os.path.isdir(pio_dir): @@ -129,19 +142,22 @@ def buildlib(bldroot, installpath, case): valid_values += ",pnetcdf" if netcdf4_parallel_found: valid_values += ",netcdf4p,netcdf4c" - logger.warning("Updating valid_values for PIO_TYPENAME: {}".format(valid_values)) + _set_pio_valid_values(case, valid_values) - case.set_valid_values("PIO_TYPENAME",valid_values) + +def _set_pio_valid_values(case, valid_values): # nothing means use the general default valid_values += ",nothing" + logger.warning("Updating valid_values for PIO_TYPENAME: {}".format(valid_values)) + env_run = case.get_env("run") + env_run.set_valid_values("PIO_TYPENAME",valid_values) for comp in case.get_values("COMP_CLASSES"): comp_pio_typename = "{}_PIO_TYPENAME".format(comp) - case.set_valid_values(comp_pio_typename,valid_values) current_value = case.get_value(comp_pio_typename) if current_value not in valid_values: logger.warning("Resetting PIO_TYPENAME to netcdf for component {}".format(comp)) - case.set_value(comp_pio_typename,"netcdf") + env_run.set_value(comp_pio_typename,"netcdf") def _main(argv, documentation): bldroot, installpath, caseroot = parse_command_line(argv, documentation) diff --git a/src/components/data_comps/datm/cime_config/config_component.xml b/src/components/data_comps/datm/cime_config/config_component.xml index e5a5197033d4..11ef218e9a0e 100644 --- a/src/components/data_comps/datm/cime_config/config_component.xml +++ b/src/components/data_comps/datm/cime_config/config_component.xml @@ -70,6 +70,7 @@ trans_1850-2000 trans_1850-2000 cplhist + none run_component_datm env_run.xml diff --git a/src/components/data_comps/datm/nuopc/datm_comp_mod.F90 b/src/components/data_comps/datm/nuopc/datm_comp_mod.F90 index 80cf563721db..dff6722e109d 100644 --- a/src/components/data_comps/datm/nuopc/datm_comp_mod.F90 +++ b/src/components/data_comps/datm/nuopc/datm_comp_mod.F90 @@ -594,7 +594,7 @@ subroutine datm_comp_init(x2a, a2x, & ! error check that mesh lats and lons correspond to those on the input domain file klon = mct_aVect_indexRA(SDATM%grid%data,'lon') do n = 1, lsize - if (abs( SDATM%grid%data%rattr(klon,n) - xc(n)) > 1.e-5) then + if (abs(mod(SDATM%grid%data%rattr(klon,n) - xc(n),360.0_R8)) > 1.e-5) then write(6,*)'ERROR: DATM n, lon(domain), lon(mesh) = ',n, SDATM%grid%data%rattr(klon,n),xc(n) write(6,*)'ERROR: DATM lon diff = ',abs(SDATM%grid%data%rattr(klon,n) - xc(n)),' too large' call shr_sys_abort() diff --git a/src/components/data_comps/desp/cime_config/config_component.xml b/src/components/data_comps/desp/cime_config/config_component.xml index ed289090c793..29ce7addb170 100644 --- a/src/components/data_comps/desp/cime_config/config_component.xml +++ b/src/components/data_comps/desp/cime_config/config_component.xml @@ -14,7 +14,7 @@ --> - Data External System Processor (DESP) + Data External System Processor (DESP) no modification of any model data test modification of any model data diff --git a/src/drivers/mct/cime_config/config_component_e3sm.xml b/src/drivers/mct/cime_config/config_component_e3sm.xml index 7557793b50c9..aafd3b4a0ff3 100644 --- a/src/drivers/mct/cime_config/config_component_e3sm.xml +++ b/src/drivers/mct/cime_config/config_component_e3sm.xml @@ -168,7 +168,7 @@ CESM1_MOD CESM1_MOD CESM1_MOD - RASM_OPTION1 + RASM_OPTION1 run_coupling env_run.xml @@ -202,16 +202,16 @@ CO2A CO2A CO2A - CO2A_OI - CO2A_OI - CO2C - CO2C - CO2C - CO2C - CO2C_OI - CO2C_OI - CO2C_OI - CO2C_OI + CO2A_OI + CO2A_OI + CO2C + CO2C + CO2C + CO2C + CO2C_OI + CO2C_OI + CO2C_OI + CO2C_OI run_coupling env_run.xml diff --git a/tools/cprnc/README b/tools/cprnc/README index 6a25be8931f6..025417ad25f5 100644 --- a/tools/cprnc/README +++ b/tools/cprnc/README @@ -138,8 +138,10 @@ SUMMARY of cprnc: and 17 had differences in fill patterns and 2 had differences in dimension sizes A total number of 10 fields could not be analyzed - A total number of 0 fields on file 1 were not found on file2 - A total number of 0 fields on file 2 were not found on file1 + A total number of 0 time-varying fields on file 1 were not found on file 2. + A total number of 0 time-constant fields on file 1 were not found on file 2. + A total number of 0 time-varying fields on file 2 were not found on file 1. + A total number of 0 time-constant fields on file 2 were not found on file 1. diff_test: the two files seem to be DIFFERENT @@ -150,14 +152,24 @@ This summarizes: - the number of fields with differences in fill patterns - the number of fields with differences in dimension sizes - the number of fields that could not be analyzed -- the number of fields that could not be found on the second file -- the number of fields that could not be found on the first file +- the number of fields on one file but not the other + - for files with an unlimited (time) dimension, these counts are + broken down into time-varying fields (i.e., fields with an unlimited + dimension) and time-constant fields (i.e., fields without an + unlimited dimension) - whether the files are IDENTICAL, DIFFERENT, or DIFFER only in their field lists - Files are considered DIFFERENT if there are differences in the values, fill patterns or dimension sizes of any variable - Files are considered to "DIFFER only in their field lists" if matching variables are all identical, but there are either fields on file1 that are not on file2, or fields on file2 that are not on file1 + - However, if the only difference in field lists is in the presence + or absence of time-constant fields on a file that has an unlimited + (time) dimension, the files are considered to be IDENTICAL, with + an extra message appended that notes this fact. (While not ideal, + this exception is needed so that exact restart tests pass despite + some time-constant fields being on the output files from one case + but not the other.) Developers Guide: ----------------- diff --git a/tools/cprnc/compare_vars_mod.F90.in b/tools/cprnc/compare_vars_mod.F90.in index 8586e71f9a2d..802321cbd303 100644 --- a/tools/cprnc/compare_vars_mod.F90.in +++ b/tools/cprnc/compare_vars_mod.F90.in @@ -1,5 +1,5 @@ module compare_vars_mod - use filestruct, only : file_t, var_t, vdimsize, dim_t, verbose + use filestruct, only : file_t, var_t, is_time_varying, vdimsize, dim_t, verbose use prec, only : r4, r8, i4 use netcdf, only : nf90_char, nf90_int, nf90_double, nf90_float, nf90_get_var, nf90_max_dims, & nf90_inq_varid, nf90_get_att, nf90_noerr @@ -40,7 +40,6 @@ contains integer, allocatable :: nsteph(:) character(len=132) :: dimstr type(dim_t), pointer :: udim - logical :: file_has_unlimited_dim real(r8), parameter :: timeepsilon = 1.e-9 ! time diff less than this considered insignificant @@ -48,6 +47,11 @@ contains vsizes_differ = 0 vnot_analyzed = 0 if(n==2 .and. .not.ignoretime) then + ! NOTE(wjs, 2019-03-21) Most of the cprnc code allows the unlimited dimension to be + ! named anything - not necessarily 'time'. But this block of code assumes that the + ! unlimited dimension is named 'time' in order to find the associated coordinate + ! variable. We should probably generalize this by looking for a variable with the + ! same name as the unlimited dimension. call checknf90(nf90_inq_varid(file(1)%fh, 'time', vid1), & err_str='These files don''t have a time dimension, use cprnc with -m') @@ -70,17 +74,15 @@ contains end if nvars = size(file(1)%var) - if (file(1)%unlimdimid == -1) then - file_has_unlimited_dim = .false. + if (file(1)%has_unlimited_dim()) then + udim => file(1)%dim(file(1)%unlimdimid) + else if (.not. ignoretime) then write(6,*) 'ERROR: For files without an unlimited dimension,' write(6,*) 'ignore_time needs to be true (via setting the -m flag to cprnc)' stop end if - else - file_has_unlimited_dim = .true. - udim => file(1)%dim(file(1)%unlimdimid) - endif + end if ndiffs = 0 nfilldiffs = 0 @@ -89,7 +91,7 @@ contains do i=1,nvars v1 => file(1)%var(i) - if (.not. is_time_varying(v1, file_has_unlimited_dim, file(1)%unlimdimid)) then + if (.not. is_time_varying(v1, file(1)%has_unlimited_dim(), file(1)%unlimdimid)) then call get_dimname_str(v1%ndims,v1%dimids,file(1)%dim,dimstr) write(6,140) trim(v1%name),trim(dimstr) vtotal = vtotal+1 @@ -103,7 +105,7 @@ contains end do ! Now look at variables that DO have unlimdim - if (file_has_unlimited_dim) then + if (file(1)%has_unlimited_dim()) then ierr = nf90_inq_varid(file(1)%fh, 'nsteph', vidnsteph) if(ierr == NF90_NOERR) then @@ -146,7 +148,7 @@ contains do i=1,nvars v1 => file(1)%var(i) - if (is_time_varying(v1, file_has_unlimited_dim, file(1)%unlimdimid)) then + if (is_time_varying(v1, file(1)%has_unlimited_dim(), file(1)%unlimdimid)) then call get_dimname_str(v1%ndims,v1%dimids,file(1)%dim,dimstr) vtotal = vtotal+1 write(6,145) trim(v1%name),trim(dimstr), t1, t2 @@ -160,7 +162,7 @@ contains end if end do end do - end if ! if (file_has_unlimited_dim) + end if ! if (file(1)%has_unlimited_dim()) 140 format(1x,a,3x,a) 145 format(1x,a,3x,a,' t_index = ',2i6) @@ -606,20 +608,5 @@ contains end function translate_loc - function is_time_varying(var, file_has_unlimited_dim, unlimdimid) - type(var_t), intent(in) :: var ! variable of interest - logical , intent(in) :: file_has_unlimited_dim ! true if the file has an unlimited dimension - integer , intent(in) :: unlimdimid ! the file's unlimited dim id (if it has one) - - logical :: is_time_varying ! true if the given variable is time-varying - - if (file_has_unlimited_dim) then - is_time_varying = any(var%dimids == unlimdimid) - else - is_time_varying = .false. - end if - end function is_time_varying - - end module compare_vars_mod diff --git a/tools/cprnc/cprnc.F90 b/tools/cprnc/cprnc.F90 index 24b834352c5f..b85075c5acc7 100644 --- a/tools/cprnc/cprnc.F90 +++ b/tools/cprnc/cprnc.F90 @@ -18,7 +18,18 @@ program piocprnc type(dim_t) :: dimoptions(12) integer :: dimoptioncnt integer :: nvars, ndiffs, nfilldiffs + + ! The following variables count the number of fields found on one file but not the + ! other, only considering (a) fields with an unlimited (time) dimension, and (b) fields + ! without an unlimited (time) dimension on a file that doesn't have an unlimited + ! dimension. integer :: num_not_found_on_file1, num_not_found_on_file2 + + ! The following variables count the number of fields found on one file but not the + ! other, only considering fields without an unlimited (time) dimension on a file that + ! has an unlimited dimension. + integer :: num_not_found_on_file1_timeconst, num_not_found_on_file2_timeconst + integer :: num_sizes_differ integer :: num_not_analyzed @@ -90,8 +101,13 @@ program piocprnc num_not_found_on_file1 = 0 num_not_found_on_file2 = 0 + num_not_found_on_file1_timeconst = 0 + num_not_found_on_file2_timeconst = 0 call match_vars( file(1), file(2), & - num_not_found_on_file1, num_not_found_on_file2) + num_not_found_on_file1 = num_not_found_on_file1, & + num_not_found_on_file2 = num_not_found_on_file2, & + num_not_found_on_file1_timeconst = num_not_found_on_file1_timeconst, & + num_not_found_on_file2_timeconst = num_not_found_on_file2_timeconst) end if call compare_vars(numcases, file, nvars, ndiffs, nfilldiffs, & num_sizes_differ, num_not_analyzed) @@ -114,15 +130,44 @@ program piocprnc write(6,700) ' and ',num_sizes_differ,' had different dimension sizes' write(6,700) ' A total number of ',num_sizes_differ + num_not_analyzed, & ' fields could not be analyzed' - write(6,700) ' A total number of ',num_not_found_on_file2,' fields on file 1 were not found on file 2.' - write(6,700) ' A total number of ',num_not_found_on_file1,' fields on file 2 were not found on file 1.' + + call print_fields_not_found( & + filenum = 1, & + file_has_unlimited_dim = file(1)%has_unlimited_dim(), & + num_not_found = num_not_found_on_file2, & + num_not_found_timeconst = num_not_found_on_file2_timeconst) + + call print_fields_not_found( & + filenum = 2, & + file_has_unlimited_dim = file(2)%has_unlimited_dim(), & + num_not_found = num_not_found_on_file1, & + num_not_found_timeconst = num_not_found_on_file1_timeconst) + if (nvars == 0 .or. ndiffs > 0 .or. nfilldiffs > 0 .or. & num_sizes_differ > 0 .or. num_not_analyzed >= nvars) then write(6,700) ' diff_test: the two files seem to be DIFFERENT ' else if (num_not_found_on_file1 > 0 .or. num_not_found_on_file2 > 0) then + ! Note that we deliberately allow num_not_found_on_file1_timeconst or + ! num_not_found_on_file2_timeconst to be > 0: those do NOT result in a + ! "DIFFER" result. + ! + ! Ideally, we'd count those fields here, too. Doing so would catch more + ! differences and would simplify the cprnc code. But this sometimes leads to + ! problems when comparing restart vs. baseline files + ! (https://github.com/ESMCI/cime/issues/3007). We could add a flag that you + ! specify to not count these fields, but there are backwards compatibility + ! issues with doing so. Eventually it could be good to count these absent + ! fields as a DIFFER result by default, adding a flag that you can specify to + ! not count them, then have cime specify this flag when doing the in-test + ! comparison (so absent time-constant fields would result in a DIFFER result + ! for cime's baseline comparisons and for interactive use of cprnc). write(6,'(a)') ' diff_test: the two files DIFFER only in their field lists' else write(6,700) ' diff_test: the two files seem to be IDENTICAL ' + if (num_not_found_on_file1_timeconst > 0 .or. & + num_not_found_on_file2_timeconst > 0) then + write(6,'(a)') ' (But note that there were differences in field lists just for time-constant fields.)' + end if end if end if write(6,*) ' ' @@ -213,4 +258,51 @@ subroutine parsearg (arg, dimname, v1, v2) return end subroutine parsearg + subroutine print_fields_not_found(filenum, file_has_unlimited_dim, & + num_not_found, num_not_found_timeconst) + ! Prints information about the number of fields in filenum not found on the other file + + integer, intent(in) :: filenum ! file number for which we're printing this information + logical, intent(in) :: file_has_unlimited_dim ! whether this file has an unlimited dimension + + ! Number of fields in filenum but not on the other file, only considering (a) fields + ! with an unlimited (time) dimension, and (b) fields without an unlimited (time) + ! dimension on a file that doesn't have an unlimited dimension + integer, intent(in) :: num_not_found + + ! Number of fields in filenum but not on the other file, only considering fields + ! without an unlimited (time) dimension on a file that has an unlimited dimension + integer, intent(in) :: num_not_found_timeconst + + integer :: other_filenum + + if (filenum == 1) then + other_filenum = 2 + else if (filenum == 2) then + other_filenum = 1 + else + stop 'Unexpected value for filenum' + end if + + if (file_has_unlimited_dim) then + write(6,'(a,i6,a,i1,a,i1,a)') & + ' A total number of ', num_not_found, & + ' time-varying fields on file ', filenum, & + ' were not found on file ', other_filenum, '.' + write(6,'(a,i6,a,i1,a,i1,a)') & + ' A total number of ', num_not_found_timeconst, & + ' time-constant fields on file ', filenum, & + ' were not found on file ', other_filenum, '.' + else + write(6,'(a,i6,a,i1,a,i1,a)') & + ' A total number of ', num_not_found, & + ' fields on file ', filenum, & + ' were not found on file ', other_filenum, '.' + if (num_not_found_timeconst > 0) then + stop 'Programming error: file has no unlimited dimension, but num_not_found_timeconst > 0' + end if + end if + + end subroutine print_fields_not_found + end program piocprnc diff --git a/tools/cprnc/filestruct.F90 b/tools/cprnc/filestruct.F90 index 4e014c02ae41..7491e9e3b253 100644 --- a/tools/cprnc/filestruct.F90 +++ b/tools/cprnc/filestruct.F90 @@ -22,11 +22,24 @@ module filestruct type(dim_t), pointer :: dim(:) type(var_t), pointer :: var(:) integer :: unlimdimid + contains + procedure :: has_unlimited_dim ! logical function; returns true if this file has an unlimited dimension end type file_t logical :: verbose contains + logical function has_unlimited_dim(file) + ! Returns true if this file has an unlimited dimension + class(file_t), intent(in) :: file + + if (file%unlimdimid == -1) then + has_unlimited_dim = .false. + else + has_unlimited_dim = .true. + end if + end function has_unlimited_dim + subroutine init_file_struct( file, dimoptions ) type(file_t) :: file @@ -254,15 +267,30 @@ end subroutine compare_dimensions subroutine match_vars( file1, file2, & - num_not_found_on_file1, num_not_found_on_file2 ) + num_not_found_on_file1, num_not_found_on_file2, & + num_not_found_on_file1_timeconst, num_not_found_on_file2_timeconst) type(file_t), intent(inout) :: file1, file2 - ! Accumulates count of variables on file2 not found on file1 + ! Accumulates count of variables on file2 not found on file1; this only considers (a) + ! fields with an unlimited (time) dimension, and (b) fields without an unlimited + ! (time) dimension on a file that doesn't have an unlimited dimension. integer, intent(inout) :: num_not_found_on_file1 - ! Accumulates count of variables on file1 not found on file2 + ! Accumulates count of variables on file1 not found on file2; this only considers (a) + ! fields with an unlimited (time) dimension, and (b) fields without an unlimited + ! (time) dimension on a file that doesn't have an unlimited dimension. integer, intent(inout) :: num_not_found_on_file2 + ! Accumulates count of variables on file2 not found on file1; this only considers + ! fields without an unlimited (time) dimension on a file that has an unlimited + ! dimension. + integer, intent(inout) :: num_not_found_on_file1_timeconst + + ! Accumulates count of variables on file1 not found on file2; this only considers + ! fields without an unlimited (time) dimension on a file that has an unlimited + ! dimension. + integer, intent(inout) :: num_not_found_on_file2_timeconst + type(var_t), pointer :: varfile1(:),varfile2(:) integer :: vs1, vs2, i, j @@ -286,18 +314,43 @@ subroutine match_vars( file1, file2, & do i=1,vs1 if(varfile1(i)%matchid<0) then print *, 'Could not find match for file1 variable ',trim(varfile1(i)%name), ' in file2' - num_not_found_on_file2 = num_not_found_on_file2 + 1 + if (file1%has_unlimited_dim() .and. & + .not. is_time_varying(varfile1(i), file1%has_unlimited_dim(), file1%unlimdimid)) then + num_not_found_on_file2_timeconst = num_not_found_on_file2_timeconst + 1 + else + num_not_found_on_file2 = num_not_found_on_file2 + 1 + end if end if end do do i=1,vs2 if(varfile2(i)%matchid<0) then print *, 'Could not find match for file2 variable ',trim(varfile2(i)%name), ' in file1' - num_not_found_on_file1 = num_not_found_on_file1 + 1 + if (file2%has_unlimited_dim() .and. & + .not. is_time_varying(varfile2(i), file2%has_unlimited_dim(), file2%unlimdimid)) then + num_not_found_on_file1_timeconst = num_not_found_on_file1_timeconst + 1 + else + num_not_found_on_file1 = num_not_found_on_file1 + 1 + end if end if end do end subroutine match_vars + function is_time_varying(var, file_has_unlimited_dim, unlimdimid) + type(var_t), intent(in) :: var ! variable of interest + logical , intent(in) :: file_has_unlimited_dim ! true if the file has an unlimited dimension + integer , intent(in) :: unlimdimid ! the file's unlimited dim id (if it has one) + + logical :: is_time_varying ! true if the given variable is time-varying + + if (file_has_unlimited_dim) then + is_time_varying = any(var%dimids == unlimdimid) + else + is_time_varying = .false. + end if + end function is_time_varying + + function vdimsize(dims, dimids) type(dim_t), intent(in) :: dims(:) integer, intent(in) :: dimids(:) diff --git a/tools/cprnc/run_tests b/tools/cprnc/run_tests index 8ed634c157fd..908c1f24a20b 100755 --- a/tools/cprnc/run_tests +++ b/tools/cprnc/run_tests @@ -31,9 +31,12 @@ my %tests = ('copy.nc' => {control => 'control.nc'}, 'vals_differ_by_varying_amounts2.nc' => {control => 'control.nc'}, 'multipleTimes_someTimeless_diffs_in_vals_and_fill.nc' => {control => 'control_multipleTimes_someTimeless.nc'}, + 'multipleTimes_someTimeless_extra_and_missing.nc' => {control => 'control_multipleTimes_someTimeless.nc'}, 'noTime_diffs_in_vals_and_fill.nc' => {control => 'control_noTime.nc', extra_args => '-m'}, + 'noTime_extra_and_missing.nc' => {control => 'control_noTime.nc', + extra_args => '-m'}, 'diffs_0d.nc' => {control => 'control_0d.nc', extra_args => '-m'}, diff --git a/tools/cprnc/test_inputs/README b/tools/cprnc/test_inputs/README index 5818bbbb44a8..b58d3816de48 100644 --- a/tools/cprnc/test_inputs/README +++ b/tools/cprnc/test_inputs/README @@ -3,7 +3,7 @@ This directory contains simple test inputs to test cprnc. All comparisons can be run by running the run_tests script in the parent directory. Suggestion: run this once from the baseline directory, then once from the new directory; compare against baselines -with, e.g.: +by doing a directory diff of the two directories, or with, e.g.: baseline_out=/PATH/TO/BASELINE/OUTPUT new_out=/PATH/TO/NEW/OUTPUT @@ -19,7 +19,7 @@ The files here are: - diffs_in_vals_and_extra_and_missing.nc: one variable has differences in values; also, one variable is missing and there is an extra variable. Purpose - of this test is to make sure that this cas is reported as a DIFFERENCE rather + of this test is to make sure that this case is reported as a DIFFERENCE rather than just a warning due to the missing fields. - diffs_in_fill.nc: one variable has differences in fill pattern @@ -30,11 +30,11 @@ The files here are: - diffs_in_vals_and_fill.nc: a single variable has differences in both values and fill pattern -- extra_variables.nc: has two extra variables beyond those in copy.nc +- extra_variables.nc: has two extra variables beyond those in control.nc - lon_differs.nc: number of longitude points differs -- missing_variables.nc: missing two variables that are present in copy.nc +- missing_variables.nc: missing two variables that are present in control.nc - vals_differ_by_1.1.nc: testvar has values equal to 1.1 times those in the control file. This is useful for testing the relative @@ -103,6 +103,13 @@ with time first. same for both variables (e.g., RMS errors should be the same for both). +- multipleTimes_someTimeless_extra_and_missing.nc: two timeless + variables are missing and there is one extra timeless + variable. Purpose of this test is to make sure that the results are + reported as IDENTICAL when the only diffs in field lists are variables + without an unlimited dimension (in a file that has an unlimited + dimension). + --- FILES COMPARED AGAINST control_noTime.nc --- Note: This file has no time (unlimited) dimension. @@ -110,6 +117,11 @@ Note: This file has no time (unlimited) dimension. - noTime_diffs_in_vals_and_fill.nc: a single variable has differences in both values and fill pattern +- noTime_extra_and_missing.nc: two variables are missing and there is + one extra variable. Purpose of this test is to make sure that even + missing fields without an unlimited dimension trigger a DIFFER result + if the file doesn't have an unlimited dimension to begin with. + --- FILES COMPARED AGAINST control_0d.nc --- Note: This file has two 0-d variables diff --git a/tools/cprnc/test_inputs/multipleTimes_someTimeless_extra_and_missing.nc b/tools/cprnc/test_inputs/multipleTimes_someTimeless_extra_and_missing.nc new file mode 100644 index 0000000000000000000000000000000000000000..d2718a86de5d7b3c05025f2af2d0eebd97eed49e GIT binary patch literal 1660 zcmcgs!EVz)5OtH5me7hG_<*?)q}Gj{&{9hXM~Na1Krazj<0eaDVedxXbwqFZ1U`U6 zKZOGy!YA+vym9Qv32l)Obmixn-PxTtvz~FUKiIM?s}3{@S&u^l)!N~CtR(9-VB18A z;0eY)z-znHNE?-2@fzl}r^9JRZ^M*ahn%+8aqy7aa?U-Hqg2Q+5p+B!Bea=^sT)Ye zPLGOtyO>jw#U`4?VhE!Sv`TU<7Fq}5vq{4sl;a?Yw2tJ&mZQcn6JWg}_XRo6y;jR} zPnosNte-R;cPpeNnM)%jO{(HxjScQ@HmrqlBWY`$bd}~tmSxr}nreQ3N8j<(s2eMg!u0wBx|oSHL_ukqi&RHS zQpY~CPpSDDH82Y&f?m?pn3;ESB1g*BA8i~wqMjO8ER)DgvrBuV65hmk#ypRJ2S8ch zT=zV2iG=;t964Aj{t1vy9vP?3aE-sJXG&#~yt2 zAs=s4K9=&nVp;m+-rS6hZ9EQ&CJ5$XoE6Q-~S8|zKDegnB% z!~r$`7jSR$xUU%aUiQkr0(8##zGL_b&hj6}d6)c9^Sa@0_8od@;~4o{=64EN^YQW* zz&Fe4Lhlmb10R3|@CCTGtXI%|3&1Pif4w~8|9~Cq-9vziJ&UF7PJcgf2;*P-^>eTP J!7px-$1k|aV$T2o literal 0 HcmV?d00001 diff --git a/tools/cprnc/test_inputs/noTime_extra_and_missing.nc b/tools/cprnc/test_inputs/noTime_extra_and_missing.nc new file mode 100644 index 0000000000000000000000000000000000000000..c6c2d7909005206289354294c6d87cb2f12c8272 GIT binary patch literal 952 zcmcgr!EVz)5Oo`>me5KZIB=X}kQx`q1zJmpM6MzZKrRv2Ws@wig}rO-u0wm{6Ziy< zd`3Tm0|!2VPvDImqX@y3RbJ-pZ061E&Lq8>?gj1Y!|VgSLVETbG~8(B>_6r`aG2%J z8+!xV_`lDynqEswqllt7iK8UGq|xK(G9kURO3PBwa6?`>zmYaR-I8&5Ppg??ax= z?u_{W`T0sm-Ee{Poq7GQ{GYeEn*R_uze`gm?EZ^SK`;gx<7>?P3vdhk2!crf+y@Bz WaqDmP;FAh~^5iRU3w#592Ei|HSG!06 literal 0 HcmV?d00001 diff --git a/tools/mapping/gen_domain_files/src/gen_domain.F90 b/tools/mapping/gen_domain_files/src/gen_domain.F90 index a6ce35584069..788bd8d7b0bb 100644 --- a/tools/mapping/gen_domain_files/src/gen_domain.F90 +++ b/tools/mapping/gen_domain_files/src/gen_domain.F90 @@ -38,9 +38,9 @@ program fmain character(LEN=512) :: usercomment ! user comment character(LEN= 8) :: cdate ! wall clock date character(LEN=10) :: ctime ! wall clock time - real(r8) :: fminval = 0.001_r8 ! min allowable land fraction; frac set to 0 if frac < fminval - real(r8) :: fmaxval = 1.000_r8 ! max allowable land fraction; frac set to 1 if frac > fmaxval - logical :: set_omask = .false. ! set ocn mask if not present in input mapping file + real(r8) :: fminval ! min allowable land fraction; frac set to 0 if frac < fminval + real(r8) :: fmaxval ! max allowable land fraction; frac set to 1 if frac > fmaxval + logical :: set_omask ! set ocn mask if not present in input mapping file !---------------------------------------------------- ! Initialize options before parsing command line arguments @@ -49,6 +49,9 @@ program fmain fn1_out = 'null' fn2_out = 'null' usercomment = 'null' + fminval = 0.001_r8 + fmaxval = 1 + set_omask = .false. ! Make sure we have arguments nargs = iargc() @@ -519,9 +522,10 @@ subroutine check_ret(ret, fatal) implicit none integer, intent(in) :: ret logical, intent(in), optional :: fatal - logical :: fatal_local = .true. + logical :: fatal_local ! Default is to die when error is encountered + fatal_local = .true. if (present(fatal)) fatal_local = fatal if (ret /= NF_NOERR) then From 4171b5fab00156bd68c8498f825c3ab4d6680b19 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Thu, 11 Apr 2019 13:13:41 -0600 Subject: [PATCH 22/54] Improve robustness of wget Better error messages and avoid check certificates. [BFB] --- scripts/lib/CIME/Servers/wget.py | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/scripts/lib/CIME/Servers/wget.py b/scripts/lib/CIME/Servers/wget.py index eb6857918845..a045676b901a 100644 --- a/scripts/lib/CIME/Servers/wget.py +++ b/scripts/lib/CIME/Servers/wget.py @@ -15,9 +15,9 @@ def __init__(self, address, user='', passwd=''): self._args += "--password {} ".format(passwd) self._server_loc = address - err = run_cmd("wget {} --spider {}".format(self._args, address))[0] - expect(err == 0,"Could not connect to repo '{0}'\nThis is most likely either a proxy, or network issue .") - + cmd = "wget {} --no-check-certificate --spider {}".format(self._args, address) + err, output, _ = run_cmd(cmd, combine_output=True) + expect(err == 0,"Could not connect to repo via '{}'\nThis is most likely either a proxy, or network issue.\nOutput:\n{}".format(cmd, output.encode('utf-8'))) def fileexists(self, rel_path): full_url = os.path.join(self._server_loc, rel_path) @@ -30,9 +30,9 @@ def fileexists(self, rel_path): def getfile(self, rel_path, full_path): full_url = os.path.join(self._server_loc, rel_path) stat, output, errput = \ - run_cmd("wget {} {} -nc --output-document {}".format(self._args, full_url, full_path)) + run_cmd("wget {} {} -nc --no-check-certificate --output-document {}".format(self._args, full_url, full_path)) if (stat != 0): - logging.warning("wget failed with output: {} and errput {}\n".format(output, errput)) + logging.warning("wget failed with output: {} and errput {}\n".format(output.encode('utf-8'), errput.encode('utf-8'))) # wget puts an empty file if it fails. try: os.remove(full_path) @@ -46,7 +46,7 @@ def getfile(self, rel_path, full_path): def getdirectory(self, rel_path, full_path): full_url = os.path.join(self._server_loc, rel_path) stat, output, errput = \ - run_cmd("wget {} {} -r -N --no-directories ".format(self._args, full_url+os.sep), from_dir=full_path) + run_cmd("wget {} {} -r -N --no-check-certificate --no-directories ".format(self._args, full_url+os.sep), from_dir=full_path) logger.debug(output) logger.debug(errput) if (stat != 0): From 74730fe796c60b56ae1e4f05fd63be1d7f199fb1 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 11 Apr 2019 16:19:45 -0600 Subject: [PATCH 23/54] fix for unit test --- src/drivers/mct/unit_test/CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/src/drivers/mct/unit_test/CMakeLists.txt b/src/drivers/mct/unit_test/CMakeLists.txt index fb27128d8574..289a49c8599e 100644 --- a/src/drivers/mct/unit_test/CMakeLists.txt +++ b/src/drivers/mct/unit_test/CMakeLists.txt @@ -9,6 +9,7 @@ add_definitions( -DNUM_COMP_INST_WAV=1 -DNUM_COMP_INST_ROF=1 -DNUM_COMP_INST_ESP=1 + -DNUM_COMP_INST_IAC=1 ) # The following definitions are needed when building with the mpi-serial library From bf5199f5b50e212309bdc6ba94e6183c8bc7064a Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Thu, 11 Apr 2019 17:27:18 -0500 Subject: [PATCH 24/54] Anvil module updates --- config/e3sm/machines/config_machines.xml | 57 +++++++----------------- 1 file changed, 16 insertions(+), 41 deletions(-) diff --git a/config/e3sm/machines/config_machines.xml b/config/e3sm/machines/config_machines.xml index 3944ca10044f..f1732910b0fe 100644 --- a/config/e3sm/machines/config_machines.xml +++ b/config/e3sm/machines/config_machines.xml @@ -1146,13 +1146,6 @@ 36 36 FALSE - srun @@ -1163,50 +1156,40 @@ - /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/sh - /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/csh + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/sh;export MODULEPATH=/blues/gpfs/software/centos7/spack-0.12.1/share/spack/lmod/linux-centos7-x86_64/Core + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/csh;setenv MODULEPATH /blues/gpfs/software/centos7/spack-0.12.1/share/spack/lmod/linux-centos7-x86_64/Core /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/env_modules_python.py - /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/libexec/lmod python + export MODULEPATH=/blues/gpfs/software/centos7/spack-0.12.1/share/spack/lmod/linux-centos7-x86_64/Core;/home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/libexec/lmod python module module - intel/18.0.4-443hhug + intel/17.0.4-nymb5wx + intel-mkl/2017.3.196-v7uuj6z + netcdf/4.4.1-magkugi + netcdf-fortran/4.4.4-7obsouy - mvapich2/2.3.1-verbs-dtbb6xk + mvapich2/2.2-verbs-lxc4y7i openmpi/3.1.3-verbs-kqojjbw - parallel-netcdf/1.8.1-5ldccd7 - - - intel-mkl/2018.4.274-jwaeshj - hdf5/1.8.16-n5thgua - netcdf/4.4.1-qs32hcj - - netcdf-fortran/4.4.4-jy3v3rz - gcc/8.2.0-g7hppkz + intel-mkl/2018.4.274-2amycpi + hdf5/1.8.16-mz7lmxh + netcdf/4.4.1-xkjcghm + netcdf-cxx/4.2-kyva3os + netcdf-fortran/4.4.4-mpstomu mvapich2/2.3.1-verbs-wcfqbl5 - openmpi/3.1.3-verbs-q4swt25 - parallel-netcdf/1.8.1-re3um7k - - - intel-mkl/2018.4.274-2amycpi - hdf5/1.8.16-mz7lmxh - netcdf/4.4.1-xkjcghm - netcdf-cxx/4.2-kyva3os - netcdf-fortran/4.4.4-mpstomu cmake @@ -1221,13 +1204,9 @@ $SHELL{which nf-config | xargs dirname | xargs dirname} /lcrc/group/acme/soft/perl/5.26.0/bin:$ENV{PATH} - - /blues/gpfs/home/software/climate/pnetcdf/1.8.1/intel-18.0.4/mvapich2-2.3.1-verbs - - - 1 - 0 - + 1 1 @@ -1236,10 +1215,6 @@ 64M - - - $SHELL{t=$ENV{OMP_NUM_THREADS};b=0;r=$[36/$t];while [ $r -gt 0 ];do printf "$b-$[$b+$t-1]:";((r--));((b=b+t));done;} - granularity=thread,scatter 1 From 176d53393451345e6bf8d2175aa7605c3463a611 Mon Sep 17 00:00:00 2001 From: Aaron Donahue Date: Thu, 11 Apr 2019 16:04:10 -0700 Subject: [PATCH 25/54] Update config files for LC resources Changes the config files in CIME to reflect recent changes in Livermore Computing resources: Update syrah and quartz machine config entries to explicitly load mvapich2/2.2 which is the only mvapich version on LC that grants access to pnetcdf/1.9.0. These changes reflect a change in the default module loads on LC machines. In addition, there is a change to the run_script to purge all mention of the machines cab and sierra (which have been taken down) and to add a warning message to the build section warning of the sensitivity of CIME to double slashes (//) in the case directory path. [BFB] - Bit-For-Bit See confluence for a more detailed description about these tags. --- config/e3sm/machines/config_machines.xml | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/config/e3sm/machines/config_machines.xml b/config/e3sm/machines/config_machines.xml index 3944ca10044f..ade1db8997d9 100644 --- a/config/e3sm/machines/config_machines.xml +++ b/config/e3sm/machines/config_machines.xml @@ -1428,8 +1428,10 @@ python git - intel - mvapich2 + intel/18.0.1 + pnetcdf/1.9.0 + mvapich2 + mvapich2/2.2 netcdf-fortran/4.4.4 pnetcdf/1.9.0 @@ -1478,8 +1480,10 @@ python git - intel - mvapich2 + intel/18.0.1 + pnetcdf/1.9.0 + mvapich2 + mvapich2/2.2 netcdf-fortran/4.4.4 pnetcdf/1.9.0 From ae960907f86f7e82c32a50f55b3c64f78f81486b Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Sun, 14 Apr 2019 16:16:29 -0500 Subject: [PATCH 26/54] Build PIO1 with pnetcdf on Anvil --- config/e3sm/machines/config_machines.xml | 4 ++-- config/e3sm/machines/config_pio.xml | 1 + 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/config/e3sm/machines/config_machines.xml b/config/e3sm/machines/config_machines.xml index f1732910b0fe..b6040de052c0 100644 --- a/config/e3sm/machines/config_machines.xml +++ b/config/e3sm/machines/config_machines.xml @@ -1204,9 +1204,9 @@ $SHELL{which nf-config | xargs dirname | xargs dirname} /lcrc/group/acme/soft/perl/5.26.0/bin:$ENV{PATH} - + 1 1 diff --git a/config/e3sm/machines/config_pio.xml b/config/e3sm/machines/config_pio.xml index 65f503aeada2..566a889c0c93 100644 --- a/config/e3sm/machines/config_pio.xml +++ b/config/e3sm/machines/config_pio.xml @@ -61,6 +61,7 @@ netcdf netcdf netcdf + netcdf From 4664dd408f6af8e5498c82f36c9b3ad559077ba4 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 15 Apr 2019 11:45:59 -0600 Subject: [PATCH 27/54] Also use 0.125nldas2 grid for rof Since the rof grid is identical to lnd, we should be able to use idmap for the rof <-> lnd mappings. --- config/cesm/config_grids.xml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/config/cesm/config_grids.xml b/config/cesm/config_grids.xml index 15a6fc954532..aed45d0eb662 100644 --- a/config/cesm/config_grids.xml +++ b/config/cesm/config_grids.xml @@ -122,11 +122,11 @@ - + 0.125nldas2 0.125nldas2 0.125nldas2 - null + 0.125nldas2 nldas2 @@ -1103,6 +1103,7 @@ 5x5 Amazon regional case -- only valid for DATM/CLM compset + 464 224 $DIN_LOC_ROOT/share/domains/domain.clm/domain.lnd.0.125nldas2_0.125nldas2.190410.nc From 34cff88f28865a01a9bfc47ca21521026258dc09 Mon Sep 17 00:00:00 2001 From: Jayesh Krishna Date: Mon, 15 Apr 2019 12:25:11 -0400 Subject: [PATCH 28/54] Upgrading Summit modules Upgrading the summit cmake, essl and MPI modules. With the older version of MPI modules, MPI_Finalize call hangs. The older version of essl module is no longer available. Fixes #2847 --- config/e3sm/machines/config_machines.xml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/config/e3sm/machines/config_machines.xml b/config/e3sm/machines/config_machines.xml index b6040de052c0..3efd70413ebc 100644 --- a/config/e3sm/machines/config_machines.xml +++ b/config/e3sm/machines/config_machines.xml @@ -3010,8 +3010,8 @@ python/3.5.2 subversion/1.9.3 git/2.13.0 - cmake/3.9.2 - essl/6.1.0-20180406 + cmake/3.13.4 + essl/6.1.0-2 netlib-lapack/3.8.0 @@ -3032,13 +3032,13 @@ - spectrum-mpi/10.2.0.10-20181214 + spectrum-mpi/10.2.0.11-20190201 - spectrum-mpi/10.2.0.10-20181214 + spectrum-mpi/10.2.0.11-20190201 - spectrum-mpi/10.2.0.10-20181214 + spectrum-mpi/10.2.0.11-20190201 From d57ef0616fb2a28bd4d45772d9febbfaf8752087 Mon Sep 17 00:00:00 2001 From: Balwinder Singh Date: Mon, 15 Apr 2019 07:51:24 -0700 Subject: [PATCH 29/54] Adds machine files for Compy This PR adds first set of machine files for E3SM machine Compy. Machine files for compilers Intel, gnu and PGI are added. I have used the following test to compile and run the model: SMS.ne4_ne4.FC5AV1C-L For the above test: -Intel compiler works fine -GNU 4.8.5: Land model has a compile time error -PGI: Netcdf is not built with this compiler yet [BFB] --- config/e3sm/machines/config_batch.xml | 10 +++ config/e3sm/machines/config_compilers.xml | 63 +++++++++++++++ config/e3sm/machines/config_machines.xml | 98 +++++++++++++++++++++++ 3 files changed, 171 insertions(+) diff --git a/config/e3sm/machines/config_batch.xml b/config/e3sm/machines/config_batch.xml index fe3128b9b59b..1967d14de665 100644 --- a/config/e3sm/machines/config_batch.xml +++ b/config/e3sm/machines/config_batch.xml @@ -386,6 +386,16 @@ + + + --output=slurm.out + --error=slurm.err + + + slurm + + + --ntasks-per-node={{ tasks_per_node }} diff --git a/config/e3sm/machines/config_compilers.xml b/config/e3sm/machines/config_compilers.xml index 879e9e076df2..fb7efd38d173 100644 --- a/config/e3sm/machines/config_compilers.xml +++ b/config/e3sm/machines/config_compilers.xml @@ -1052,6 +1052,69 @@ for mct, etc. + + + -O2 + + + --host=Linux + + + -DLINUX + + + -O2 + -g -traceback -O0 -fpe0 -check all -check noarg_temp_created -ftrapuv -init=snan + + $ENV{NETCDF_HOME} + lustre + $ENV{PNETCDFROOT} + + -lpmi -L$NETCDF_PATH/lib -lnetcdf -lnetcdff -L$ENV{MKL_PATH} -lmkl_rt + + + + + + -O2 + + + --host=Linux + + + -DLINUX + + + -O2 + -g -traceback -O0 -fpe0 -check all -check noarg_temp_created -ftrapuv + -C -Mbounds -traceback -Mchkfpstk -Mchkstk -Mdalign -Mdepchk -Mextend -Miomutex -Mrecursive -Ktrap=fp -O0 -g -byteswapio -Meh_frame + + $ENV{NETCDF_HOME} + lustre + $ENV{PNETCDFROOT} + + -lpmi -L$NETCDF_PATH/lib -lnetcdf -lnetcdff -L$ENV{MKL_PATH} -lmkl_rt -L$ENV{MPI_LIB} -lmpich + + + + + + -O2 + + + --host=Linux + + + -O2 + + $ENV{NETCDF_HOME} + lustre + + -lpmi -L$NETCDF_PATH/lib -lnetcdf -lnetcdff -L$ENV{MKL_PATH} -lmkl_rt -L$ENV{MPI_LIB} -lmpich + -L$ENV{PNETCDF_HOME}/lib -lpnetcdf -L$ENV{HDF5_PATH}/lib -lhdf5_hl -lhdf5 + + + --host=Linux diff --git a/config/e3sm/machines/config_machines.xml b/config/e3sm/machines/config_machines.xml index b6040de052c0..5bc78741edef 100644 --- a/config/e3sm/machines/config_machines.xml +++ b/config/e3sm/machines/config_machines.xml @@ -1973,6 +1973,104 @@ + + PNL E3SM Intel Xeon Gold 6148(Skylake) nodes, OS is Linux, SLURM + compy + LINUX + intel,pgi,gnu + mvapich2,openmpi + /compyfs/$USER/e3sm_scratch + /compyfs/inputdata + /compyfs/inputdata/atm/datm7 + /compyfs/$USER/e3sm_scratch/archive/$CASE + /compyfs/e3sm_baselines/$COMPILER + /compyfs/e3sm_baselines/cprnc/cprnc + 8 + slurm + bibi.mathew -at- pnnl.gov + 40 + 40 + TRUE + + + + + srun + + --mpi=none + --ntasks={{ total_tasks }} + --cpu_bind=sockets --cpu_bind=verbose + --kill-on-bad-exit + + + + mpirun + + -n {{ total_tasks }} + + + + mpirun + + -n {{ total_tasks }} + + + + /share/apps/modules/init/perl.pm + /share/apps/modules/init/python.py + /etc/profile.d/modules.csh + /etc/profile.d/modules.sh + /share/apps/modules/bin/modulecmd perl + /share/apps/modules/bin/modulecmd python + module + module + + + + + intel/19.0.3 + mkl/2019u3 + + + pgi/19.1 + mkl/2019u3 + + + gcc/4.8.5 + mkl/2019u3 + + + mvapich2/2.3.1 + + + mvapich2/2.3.1 + + + mvapich2/2.3.1 + + + openmpi/3.1.3 + + + netcdf/4.6.3 + + + netcdf/4.6.3 + + + netcdf/4.6.3 + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + + 64M + $ENV{NETCDF_ROOT}/ + + + $ENV{MKLROOT} + + ORNL XK6, os is Linux, 32 pes/node, batch system is PBS From d90c5443fe4dd4a39eb96b35887bebd00a34910a Mon Sep 17 00:00:00 2001 From: Balwinder Singh Date: Mon, 15 Apr 2019 14:18:29 -0700 Subject: [PATCH 30/54] PGI works now and gnu builds fine gnu compiler builds fine but blows up during run time with following error: set_time_float_from_date: error return from ESMF_TimeSet for set_time_float_from_date ERROR: CHKRC [BFB] - Bit-For-Bit --- config/e3sm/machines/config_compilers.xml | 12 +++++------ config/e3sm/machines/config_machines.xml | 26 ++++++----------------- 2 files changed, 11 insertions(+), 27 deletions(-) diff --git a/config/e3sm/machines/config_compilers.xml b/config/e3sm/machines/config_compilers.xml index fb7efd38d173..d1cf6c620d22 100644 --- a/config/e3sm/machines/config_compilers.xml +++ b/config/e3sm/machines/config_compilers.xml @@ -1070,7 +1070,7 @@ for mct, etc. lustre $ENV{PNETCDFROOT} - -lpmi -L$NETCDF_PATH/lib -lnetcdf -lnetcdff -L$ENV{MKL_PATH} -lmkl_rt + -lpmi -L$NETCDF_PATH/lib -lnetcdf -lnetcdff -L$ENV{MKL_PATH}/lib/intel64/ -lmkl_rt @@ -1086,15 +1086,14 @@ for mct, etc. -O2 - -g -traceback -O0 -fpe0 -check all -check noarg_temp_created -ftrapuv -C -Mbounds -traceback -Mchkfpstk -Mchkstk -Mdalign -Mdepchk -Mextend -Miomutex -Mrecursive -Ktrap=fp -O0 -g -byteswapio -Meh_frame $ENV{NETCDF_HOME} lustre $ENV{PNETCDFROOT} - - -lpmi -L$NETCDF_PATH/lib -lnetcdf -lnetcdff -L$ENV{MKL_PATH} -lmkl_rt -L$ENV{MPI_LIB} -lmpich - + + -lpmi -L$NETCDF_PATH/lib -lnetcdf -lnetcdff -L$ENV{MKL_PATH}/lib/intel64/ -lmkl_rt + @@ -1110,8 +1109,7 @@ for mct, etc. $ENV{NETCDF_HOME} lustre - -lpmi -L$NETCDF_PATH/lib -lnetcdf -lnetcdff -L$ENV{MKL_PATH} -lmkl_rt -L$ENV{MPI_LIB} -lmpich - -L$ENV{PNETCDF_HOME}/lib -lpnetcdf -L$ENV{HDF5_PATH}/lib -lhdf5_hl -lhdf5 + -lpmi -L$NETCDF_PATH/lib -lnetcdf -lnetcdff -L$ENV{MKL_PATH}/lib/intel64/ -lmkl_rt diff --git a/config/e3sm/machines/config_machines.xml b/config/e3sm/machines/config_machines.xml index 5bc78741edef..3d0c0d212935 100644 --- a/config/e3sm/machines/config_machines.xml +++ b/config/e3sm/machines/config_machines.xml @@ -2029,36 +2029,22 @@ intel/19.0.3 - mkl/2019u3 - pgi/19.1 - mkl/2019u3 + pgi/18.10 - gcc/4.8.5 - mkl/2019u3 - - - mvapich2/2.3.1 + gcc/8.1.0 - - mvapich2/2.3.1 - - + mvapich2/2.3.1 openmpi/3.1.3 - - netcdf/4.6.3 - - - netcdf/4.6.3 - - + netcdf/4.6.3 + mkl/2019u3 $CIME_OUTPUT_ROOT/$CASE/run @@ -2067,7 +2053,7 @@ 64M $ENV{NETCDF_ROOT}/ - + $ENV{MKLROOT} From 43f6864f86efa1623610278792e2ec72b1187073 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Mon, 15 Apr 2019 14:27:42 -0700 Subject: [PATCH 31/54] Minor build fixes Need consistent case for USE_CXX in Makefile. Intel should not add qopenmp unless compile_threaded is TRUE. --- config/e3sm/machines/config_compilers.xml | 3 ++- scripts/Tools/Makefile | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/config/e3sm/machines/config_compilers.xml b/config/e3sm/machines/config_compilers.xml index 879e9e076df2..51406201f4a5 100644 --- a/config/e3sm/machines/config_compilers.xml +++ b/config/e3sm/machines/config_compilers.xml @@ -260,7 +260,8 @@ for mct, etc. -O0 -g - -std=c++11 -fp-model source -qopenmp + -std=c++11 -fp-model source + -qopenmp -O0 -g -O2 diff --git a/scripts/Tools/Makefile b/scripts/Tools/Makefile index aaf7e8bb1b64..de8a13872189 100644 --- a/scripts/Tools/Makefile +++ b/scripts/Tools/Makefile @@ -128,7 +128,7 @@ endif ifeq ($(strip $(PIO_VERSION)),1) CPPDEFS += -DPIO1 else - USE_CXX = true + USE_CXX = TRUE endif ifeq (,$(SHAREDPATH)) From 1a90c7750b57fe35840f3c6f022e386caa4abc27 Mon Sep 17 00:00:00 2001 From: Balwinder Singh Date: Tue, 16 Apr 2019 08:02:30 -0700 Subject: [PATCH 32/54] Modifies test to use new AQUAP compset A test has been modified to use a new AQUAP compset as the old one doesn't exist anymore [BFB] - Bit-For-Bit --- config/e3sm/tests.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config/e3sm/tests.py b/config/e3sm/tests.py index 5e94a2759320..b2e57c9eab74 100644 --- a/config/e3sm/tests.py +++ b/config/e3sm/tests.py @@ -112,7 +112,7 @@ "SMS.T62_oQU120_ais20.MPAS_LISIO_TEST", "SMS.f09_g16_a.IGCLM45_MLI", "SMS_P12x2.ne4_oQU240.A_WCYCL1850.allactive-mach_mods", - "SMS_B.ne4_ne4.FC5AV1C-L-AQUAP.cam-hommexx", + "SMS_B.ne4_ne4.F-EAMv1-AQP1.cam-hommexx", ) }, From e7b2dca36dd152c1c3c3cba43694adc6a077c262 Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Tue, 16 Apr 2019 12:09:48 -0500 Subject: [PATCH 33/54] Update Intel module key on Anvil Also add modules for intel+openmpi and reduce number of nodes in default pelayouts for quicker testing. --- config/e3sm/allactive/config_pesall.xml | 26 ++++++++++----------- config/e3sm/machines/config_machines.xml | 29 ++++++++++++------------ 2 files changed, 28 insertions(+), 27 deletions(-) diff --git a/config/e3sm/allactive/config_pesall.xml b/config/e3sm/allactive/config_pesall.xml index 86d173bd0dc8..a18ae8c60ab1 100644 --- a/config/e3sm/allactive/config_pesall.xml +++ b/config/e3sm/allactive/config_pesall.xml @@ -4552,7 +4552,7 @@ - + ne30_ne30 grid on 40 nodes 36 ppn pure-MPI 1350 @@ -4585,7 +4585,7 @@ 0 - + 77x36x1 2700 @@ -4618,7 +4618,7 @@ 0 - + 152x36x1 5400 @@ -4656,16 +4656,16 @@ - default,20nodes*36tasks*1threads - - 720 - 720 - 720 - 720 - 720 - 720 - 720 - 720 + default,4nodes*36tasks*1threads + + 144 + 144 + 144 + 144 + 144 + 144 + 144 + 144 1 diff --git a/config/e3sm/machines/config_machines.xml b/config/e3sm/machines/config_machines.xml index b6040de052c0..0260d44de72c 100644 --- a/config/e3sm/machines/config_machines.xml +++ b/config/e3sm/machines/config_machines.xml @@ -1165,17 +1165,21 @@ - - intel/17.0.4-nymb5wx + + intel/17.0.4-74uvhji intel-mkl/2017.3.196-v7uuj6z netcdf/4.4.1-magkugi netcdf-fortran/4.4.4-7obsouy - - mvapich2/2.2-verbs-lxc4y7i + cmake - openmpi/3.1.3-verbs-kqojjbw + intel/17.0.0-yil23id + intel-mkl/2017.0.098-gqttdpp + netcdf/4.4.1-qy35uvc + netcdf-fortran/4.4.4-2jrvsdv + openmpi/2.0.1-verbs-id2i464 + cmake/3.14.1-ymmizo4 gcc/8.2.0-g7hppkz @@ -1191,9 +1195,6 @@ openmpi/3.1.3-verbs-q4swt25 - - cmake - $CIME_OUTPUT_ROOT/$CASE/run $CIME_OUTPUT_ROOT/$CASE/bld @@ -1257,9 +1258,7 @@ /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/sh /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/csh - /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/perl /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/env_modules_python.py - /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/libexec/lmod perl /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/libexec/lmod python module module @@ -1273,17 +1272,19 @@ gcc/7.1.0-4bgguyp - + intel-mpi/2017.3-dfphq6k + parallel-netcdf/1.6.1 + + + mvapich2/2.2-n6lclff + parallel-netcdf/1.6.1-mvapich2.2 cmake netcdf/4.4.1.1-prsuusl netcdf-fortran/4.4.4-ojwazvy - - parallel-netcdf/1.6.1 - $CIME_OUTPUT_ROOT/$CASE/run $CIME_OUTPUT_ROOT/$CASE/bld From 7f7d4014235a20f97af1e978a7a6271a461cd579 Mon Sep 17 00:00:00 2001 From: Balwinder Singh Date: Wed, 17 Apr 2019 09:53:35 -0700 Subject: [PATCH 34/54] Adds pnetcdf required by MPAS [BFB] - Bit-For-Bit --- config/e3sm/machines/config_compilers.xml | 11 ++++++----- config/e3sm/machines/config_machines.xml | 1 + 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/config/e3sm/machines/config_compilers.xml b/config/e3sm/machines/config_compilers.xml index d1cf6c620d22..716de1583165 100644 --- a/config/e3sm/machines/config_compilers.xml +++ b/config/e3sm/machines/config_compilers.xml @@ -1067,10 +1067,10 @@ for mct, etc. -g -traceback -O0 -fpe0 -check all -check noarg_temp_created -ftrapuv -init=snan $ENV{NETCDF_HOME} + $ENV{PNETCDF_HOME} lustre - $ENV{PNETCDFROOT} - -lpmi -L$NETCDF_PATH/lib -lnetcdf -lnetcdff -L$ENV{MKL_PATH}/lib/intel64/ -lmkl_rt + -lpmi -L$NETCDF_PATH/lib -lnetcdf -lnetcdff -L$ENV{MKL_PATH}/lib/intel64/ -lmkl_rt $ENV{PNETCDF_LIBRARIES} @@ -1090,9 +1090,9 @@ for mct, etc. $ENV{NETCDF_HOME} lustre - $ENV{PNETCDFROOT} + $ENV{PNETCDF_HOME} - -lpmi -L$NETCDF_PATH/lib -lnetcdf -lnetcdff -L$ENV{MKL_PATH}/lib/intel64/ -lmkl_rt + -lpmi -L$NETCDF_PATH/lib -lnetcdf -lnetcdff -L$ENV{MKL_PATH}/lib/intel64/ -lmkl_rt $ENV{PNETCDF_LIBRARIES} @@ -1107,9 +1107,10 @@ for mct, etc. -O2 $ENV{NETCDF_HOME} + $ENV{PNETCDF_HOME} lustre - -lpmi -L$NETCDF_PATH/lib -lnetcdf -lnetcdff -L$ENV{MKL_PATH}/lib/intel64/ -lmkl_rt + -lpmi -L$NETCDF_PATH/lib -lnetcdf -lnetcdff -L$ENV{MKL_PATH}/lib/intel64/ -lmkl_rt $ENV{PNETCDF_LIBRARIES} diff --git a/config/e3sm/machines/config_machines.xml b/config/e3sm/machines/config_machines.xml index 3d0c0d212935..5ded475ec65c 100644 --- a/config/e3sm/machines/config_machines.xml +++ b/config/e3sm/machines/config_machines.xml @@ -2044,6 +2044,7 @@ netcdf/4.6.3 + pnetcdf/1.9.0 mkl/2019u3 From 37f5ebcddcf1ce6fd78465247c6e88b91c6a6f71 Mon Sep 17 00:00:00 2001 From: Balwinder Singh Date: Wed, 17 Apr 2019 10:44:03 -0700 Subject: [PATCH 35/54] Removes GNU compiler entries --- config/e3sm/machines/config_compilers.xml | 20 +------------------- config/e3sm/machines/config_machines.xml | 22 ++-------------------- 2 files changed, 3 insertions(+), 39 deletions(-) diff --git a/config/e3sm/machines/config_compilers.xml b/config/e3sm/machines/config_compilers.xml index 716de1583165..a3c4dd26c1db 100644 --- a/config/e3sm/machines/config_compilers.xml +++ b/config/e3sm/machines/config_compilers.xml @@ -1066,7 +1066,7 @@ for mct, etc. -O2 -g -traceback -O0 -fpe0 -check all -check noarg_temp_created -ftrapuv -init=snan - $ENV{NETCDF_HOME} + $ENV{NETCDF_HOME} $ENV{PNETCDF_HOME} lustre @@ -1096,24 +1096,6 @@ for mct, etc. - - - -O2 - - - --host=Linux - - - -O2 - - $ENV{NETCDF_HOME} - $ENV{PNETCDF_HOME} - lustre - - -lpmi -L$NETCDF_PATH/lib -lnetcdf -lnetcdff -L$ENV{MKL_PATH}/lib/intel64/ -lmkl_rt $ENV{PNETCDF_LIBRARIES} - - - --host=Linux diff --git a/config/e3sm/machines/config_machines.xml b/config/e3sm/machines/config_machines.xml index 5ded475ec65c..1035d6a0c2d7 100644 --- a/config/e3sm/machines/config_machines.xml +++ b/config/e3sm/machines/config_machines.xml @@ -1977,8 +1977,8 @@ PNL E3SM Intel Xeon Gold 6148(Skylake) nodes, OS is Linux, SLURM compy LINUX - intel,pgi,gnu - mvapich2,openmpi + intel,pgi + mvapich2 /compyfs/$USER/e3sm_scratch /compyfs/inputdata /compyfs/inputdata/atm/datm7 @@ -2003,18 +2003,6 @@ --kill-on-bad-exit - - mpirun - - -n {{ total_tasks }} - - - - mpirun - - -n {{ total_tasks }} - - /share/apps/modules/init/perl.pm /share/apps/modules/init/python.py @@ -2033,15 +2021,9 @@ pgi/18.10 - - gcc/8.1.0 - mvapich2/2.3.1 - - openmpi/3.1.3 - netcdf/4.6.3 pnetcdf/1.9.0 From 38fa714c7ab3de779b7f55a2b6ab843ed3eafc59 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 18 Apr 2019 13:06:42 -0600 Subject: [PATCH 36/54] Allow specific tests to ignore field list differences Due to recent changes to cprnc, differences in field lists (i.e., if one case has some diagnostic fields that are missing from the other case) are now treated as differences. However, this is a problem for some new tests that are wanted, such as ensuring that turning on carbon isotopes doesn't change answers. This commit allows a particular test type to dictate that field list differences should be ignored. For tests that use SystemTestsCompareTwo, this is as simple as adding an argument to the SystemTestsCompareTwo constructor. For other tests, a new argument can be added to the call to self._component_compare_test. (Differences in the values in shared fields are still treated as differences.) --- .../CIME/SystemTests/system_tests_common.py | 20 +++++++++---- .../SystemTests/system_tests_compare_two.py | 13 +++++++-- scripts/lib/CIME/hist_utils.py | 29 ++++++++++++++----- .../test_system_tests_compare_two.py | 2 +- 4 files changed, 48 insertions(+), 16 deletions(-) diff --git a/scripts/lib/CIME/SystemTests/system_tests_common.py b/scripts/lib/CIME/SystemTests/system_tests_common.py index ea5f29114b42..cb375ec7c43d 100644 --- a/scripts/lib/CIME/SystemTests/system_tests_common.py +++ b/scripts/lib/CIME/SystemTests/system_tests_common.py @@ -263,13 +263,20 @@ def _component_compare_copy(self, suffix): comments = copy(self._case, suffix) append_testlog(comments) - def _component_compare_test(self, suffix1, suffix2, success_change=False): + def _component_compare_test(self, suffix1, suffix2, + success_change=False, + ignore_fieldlist_diffs=False): """ Return value is not generally checked, but is provided in case a custom run case needs indirection based on success. - If success_change is True, success requires some files to be different - """ - success, comments = self._do_compare_test(suffix1, suffix2) + If success_change is True, success requires some files to be different. + If ignore_fieldlist_diffs is True, then: If the two cases differ only in their + field lists (i.e., all shared fields are bit-for-bit, but one case has some + diagnostic fields that are missing from the other case), treat the two cases + as identical. + """ + success, comments = self._do_compare_test(suffix1, suffix2, + ignore_fieldlist_diffs=ignore_fieldlist_diffs) if success_change: success = not success @@ -279,12 +286,13 @@ def _component_compare_test(self, suffix1, suffix2, success_change=False): self._test_status.set_status("{}_{}_{}".format(COMPARE_PHASE, suffix1, suffix2), status) return success - def _do_compare_test(self, suffix1, suffix2): + def _do_compare_test(self, suffix1, suffix2, ignore_fieldlist_diffs=False): """ Wraps the call to compare_test to facilitate replacement in unit tests """ - return compare_test(self._case, suffix1, suffix2) + return compare_test(self._case, suffix1, suffix2, + ignore_fieldlist_diffs=ignore_fieldlist_diffs) def _st_archive_case_test(self): result = self._case.test_env_archive() diff --git a/scripts/lib/CIME/SystemTests/system_tests_compare_two.py b/scripts/lib/CIME/SystemTests/system_tests_compare_two.py index 80ac99ca2c53..6958cf818240 100644 --- a/scripts/lib/CIME/SystemTests/system_tests_compare_two.py +++ b/scripts/lib/CIME/SystemTests/system_tests_compare_two.py @@ -52,7 +52,8 @@ def __init__(self, run_two_suffix = 'test', run_one_description = '', run_two_description = '', - multisubmit = False): + multisubmit = False, + ignore_fieldlist_diffs = False): """ Initialize a SystemTestsCompareTwo object. Individual test cases that inherit from SystemTestsCompareTwo MUST call this __init__ method. @@ -71,10 +72,16 @@ def __init__(self, when starting the second run. Defaults to ''. multisubmit (bool): Do first and second runs as different submissions. Designed for tests with RESUBMIT=1 + ignore_fieldlist_diffs (bool): If True, then: If the two cases differ only in + their field lists (i.e., all shared fields are bit-for-bit, but one case + has some diagnostic fields that are missing from the other case), treat + the two cases as identical. (This is needed for tests where one case + exercises an option that produces extra diagnostic fields.) """ SystemTestsCommon.__init__(self, case) self._separate_builds = separate_builds + self._ignore_fieldlist_diffs = ignore_fieldlist_diffs # run_one_suffix is just used as the suffix for the netcdf files # produced by the first case; we may eventually remove this, but for now @@ -250,7 +257,9 @@ def run_phase(self, success_change=False): # pylint: disable=arguments-differ # Case1 is the "main" case, and we need to do the comparisons from there self._activate_case1() self._link_to_case2_output() - self._component_compare_test(self._run_one_suffix, self._run_two_suffix, success_change=success_change) + self._component_compare_test(self._run_one_suffix, self._run_two_suffix, + success_change=success_change, + ignore_fieldlist_diffs=self._ignore_fieldlist_diffs) def copy_case1_restarts_to_case2(self): """ diff --git a/scripts/lib/CIME/hist_utils.py b/scripts/lib/CIME/hist_utils.py index fdc3c280da56..235555d4ccc8 100644 --- a/scripts/lib/CIME/hist_utils.py +++ b/scripts/lib/CIME/hist_utils.py @@ -237,7 +237,8 @@ def _hists_match(model, hists1, hists2, suffix1="", suffix2=""): return one_not_two, two_not_one, match_ups -def _compare_hists(case, from_dir1, from_dir2, suffix1="", suffix2="", outfile_suffix=""): +def _compare_hists(case, from_dir1, from_dir2, suffix1="", suffix2="", outfile_suffix="", + ignore_fieldlist_diffs=False): if from_dir1 == from_dir2: expect(suffix1 != suffix2, "Comparing files to themselves?") @@ -278,7 +279,8 @@ def _compare_hists(case, from_dir1, from_dir2, suffix1="", suffix2="", outfile_s for hist1, hist2 in match_ups: success, cprnc_log_file, cprnc_comment = cprnc(model, hist1, hist2, case, from_dir1, multiinst_driver_compare=multiinst_driver_compare, - outfile_suffix=outfile_suffix) + outfile_suffix=outfile_suffix, + ignore_fieldlist_diffs=ignore_fieldlist_diffs) if success: comments += " {} matched {}\n".format(hist1, hist2) else: @@ -304,21 +306,27 @@ def _compare_hists(case, from_dir1, from_dir2, suffix1="", suffix2="", outfile_s return all_success, comments -def compare_test(case, suffix1, suffix2): +def compare_test(case, suffix1, suffix2, ignore_fieldlist_diffs=False): """ Compares two sets of component history files in the testcase directory case - The case containing the hist files to compare suffix1 - The suffix that identifies the first batch of hist files suffix1 - The suffix that identifies the second batch of hist files + ignore_fieldlist_diffs (bool): If True, then: If the two cases differ only in their + field lists (i.e., all shared fields are bit-for-bit, but one case has some + diagnostic fields that are missing from the other case), treat the two cases as + identical. returns (SUCCESS, comments) """ rundir = case.get_value("RUNDIR") - return _compare_hists(case, rundir, rundir, suffix1, suffix2) + return _compare_hists(case, rundir, rundir, suffix1, suffix2, + ignore_fieldlist_diffs=ignore_fieldlist_diffs) -def cprnc(model, file1, file2, case, rundir, multiinst_driver_compare=False, outfile_suffix=""): +def cprnc(model, file1, file2, case, rundir, multiinst_driver_compare=False, outfile_suffix="", + ignore_fieldlist_diffs=False): """ Run cprnc to compare two individual nc files @@ -329,6 +337,10 @@ def cprnc(model, file1, file2, case, rundir, multiinst_driver_compare=False, out outfile_suffix - if non-blank, then the output file name ends with this suffix (with a '.' added before the given suffix). Use None to avoid permissions issues in the case dir. + ignore_fieldlist_diffs (bool): If True, then: If the two cases differ only in their + field lists (i.e., all shared fields are bit-for-bit, but one case has some + diagnostic fields that are missing from the other case), treat the two cases as + identical. returns (True if the files matched, log_name, comment) where 'comment' is either an empty string or one of the module-level constants @@ -376,8 +388,11 @@ def cprnc(model, file1, file2, case, rundir, multiinst_driver_compare=False, out elif "the two files seem to be DIFFERENT" in out: files_match = False elif "the two files DIFFER only in their field lists" in out: - files_match = False - comment = CPRNC_FIELDLISTS_DIFFER + if ignore_fieldlist_diffs: + files_match = True + else: + files_match = False + comment = CPRNC_FIELDLISTS_DIFFER else: expect(False, "Did not find an expected summary string in cprnc output") else: diff --git a/scripts/lib/CIME/tests/SystemTests/test_system_tests_compare_two.py b/scripts/lib/CIME/tests/SystemTests/test_system_tests_compare_two.py index 694e586e0d99..d9757bb37061 100644 --- a/scripts/lib/CIME/tests/SystemTests/test_system_tests_compare_two.py +++ b/scripts/lib/CIME/tests/SystemTests/test_system_tests_compare_two.py @@ -179,7 +179,7 @@ def run_indv(self, suffix="base", st_archive=False): if caseroot not in self.run_pass_caseroot: raise RuntimeError('caseroot not in run_pass_caseroot') - def _do_compare_test(self, suffix1, suffix2): + def _do_compare_test(self, suffix1, suffix2, ignore_fieldlist_diffs=False): """ This fake implementation allows controlling whether compare_test passes or fails From b24100e4dea0257f0e4b9f4486efbd27cc742846 Mon Sep 17 00:00:00 2001 From: Chris Fischer Date: Fri, 19 Apr 2019 10:45:16 -0600 Subject: [PATCH 37/54] Update conus grid support --- config/cesm/config_grids.xml | 4 ++-- config/cesm/config_grids_common.xml | 12 ++++++------ config/cesm/config_grids_mct.xml | 12 ++++++------ 3 files changed, 14 insertions(+), 14 deletions(-) diff --git a/config/cesm/config_grids.xml b/config/cesm/config_grids.xml index f6227709899c..e90801e62f0e 100644 --- a/config/cesm/config_grids.xml +++ b/config/cesm/config_grids.xml @@ -1392,8 +1392,8 @@ 174098 1 - $DIN_LOC_ROOT/share/domains/domain.lnd.ne0CONUSne30x8_gx1v7.190304.nc - $DIN_LOC_ROOT/share/domains/domain.ocn.ne0CONUSne30x8_gx1v7.190304.nc + $DIN_LOC_ROOT/share/domains/domain.lnd.ne0CONUSne30x8_gx1v7.190322.nc + $DIN_LOC_ROOT/share/domains/domain.ocn.ne0CONUSne30x8_gx1v7.190322.nc ne0np4CONUS.ne30x8 is a Spectral Elem 1-deg grid with a 1/8 deg refined region over the continental United States: Test support only diff --git a/config/cesm/config_grids_common.xml b/config/cesm/config_grids_common.xml index ff3e2595a1d8..2f41b5b07333 100644 --- a/config/cesm/config_grids_common.xml +++ b/config/cesm/config_grids_common.xml @@ -32,8 +32,8 @@ - cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_0.5x0.5_nomask_aave.190227.nc - cpl/gridmaps/ne0np4CONUS.ne30x8/map_0.5x0.5_nomask_TO_ne0CONUSne30x8_aave.190227.nc + cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_0.5x0.5_nomask_aave.190322.nc + cpl/gridmaps/ne0np4CONUS.ne30x8/map_0.5x0.5_nomask_TO_ne0CONUSne30x8_aave.190322.nc @@ -288,10 +288,10 @@ - cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_gland4km_aave.190227.nc - cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_gland4km_blin.190227.nc - cpl/gridmaps/gland4km/map_gland4km_TO_ne0CONUSne30x8_aave.190227.nc - cpl/gridmaps/gland4km/map_gland4km_TO_ne0CONUSne30x8_aave.190227.nc + cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_gland4km_aave.190322.nc + cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_gland4km_blin.190322.nc + cpl/gridmaps/gland4km/map_gland4km_TO_ne0CONUSne30x8_aave.190322.nc + cpl/gridmaps/gland4km/map_gland4km_TO_ne0CONUSne30x8_aave.190322.nc diff --git a/config/cesm/config_grids_mct.xml b/config/cesm/config_grids_mct.xml index b5ed729b98f9..6066cd95e402 100644 --- a/config/cesm/config_grids_mct.xml +++ b/config/cesm/config_grids_mct.xml @@ -208,15 +208,15 @@ - cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_gx1v7_aave.190227.nc - cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_gx1v7_blin.190227.nc - cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_gx1v7_patc.190227.nc - cpl/gridmaps/gx1v7/map_gx1v7_TO_ne0CONUSne30x8_aave.190227.nc - cpl/gridmaps/gx1v7/map_gx1v7_TO_ne0CONUSne30x8_aave.190227.nc + cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_gx1v7_aave.190322.nc + cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_gx1v7_blin.190322.nc + cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_gx1v7_patc.190322.nc + cpl/gridmaps/gx1v7/map_gx1v7_TO_ne0CONUSne30x8_aave.190322.nc + cpl/gridmaps/gx1v7/map_gx1v7_TO_ne0CONUSne30x8_aave.190322.nc - cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_ww3a_blin.190213.nc + cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_ww3a_blin.190322.nc From 07e6362858d4619eacdabe37a7eb81f6e2261138 Mon Sep 17 00:00:00 2001 From: Aaron Donahue Date: Fri, 19 Apr 2019 10:13:58 -0700 Subject: [PATCH 38/54] Add NETCDF_PATH to the machine config for LLNL machines. Adds the NETCDF_PATH to config_machines.xml for the Livermore machines. This is needed to sucessfully build cprnc, for example. [BFB] - Bit-For-Bit See confluence for a more detailed description about these tags. --- config/e3sm/machines/config_machines.xml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/config/e3sm/machines/config_machines.xml b/config/e3sm/machines/config_machines.xml index ade1db8997d9..361f20a6429b 100644 --- a/config/e3sm/machines/config_machines.xml +++ b/config/e3sm/machines/config_machines.xml @@ -1440,6 +1440,7 @@ /p/lscratchh/$CCSMUSER/$CASE/bld /usr/tce/packages/netcdf-fortran/netcdf-fortran-4.4.4-intel-18.0.1/ + /usr/tce/packages/netcdf-fortran/netcdf-fortran-4.4.4-intel-18.0.1/ /usr/tce/packages/pnetcdf/pnetcdf-1.9.0-intel-18.0.1-mvapich2-2.2/ @@ -1492,6 +1493,7 @@ /p/lscratchh/$CCSMUSER/$CASE/bld /usr/tce/packages/netcdf-fortran/netcdf-fortran-4.4.4-intel-18.0.1/ + /usr/tce/packages/netcdf-fortran/netcdf-fortran-4.4.4-intel-18.0.1/ /usr/tce/packages/pnetcdf/pnetcdf-1.9.0-intel-18.0.1-mvapich2-2.2/ From 498ed824857e7fbcaa024fd00bd4ee0c35204959 Mon Sep 17 00:00:00 2001 From: Jayesh Krishna Date: Mon, 22 Apr 2019 12:36:54 -0400 Subject: [PATCH 39/54] Setting summit env for OOM errors OLCF recommends setting "OMPI_MCA_io" env variable to "romio314" to prevent out of memory issues with the code. In our testing we have found that setting this env gets rid of OOM errors with certain E3SM simulations (ECP simulation runs). However also note that setting this environment variable reduces the performance of parallel HDF5 (when using NetCDF4P PIO iotype to write data). See Issue #2856 --- config/e3sm/machines/config_machines.xml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/config/e3sm/machines/config_machines.xml b/config/e3sm/machines/config_machines.xml index 3efd70413ebc..df8724c5ad1b 100644 --- a/config/e3sm/machines/config_machines.xml +++ b/config/e3sm/machines/config_machines.xml @@ -3078,6 +3078,8 @@ $ENV{OLCF_HDF5_ROOT} + + romio314 $ENV{OLCF_PARALLEL_NETCDF_ROOT} From 643f14250b5043f5b08619cf7815fd3ef110b6a4 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 22 Apr 2019 15:01:05 -0600 Subject: [PATCH 40/54] properly link nag f90 --- config/cesm/machines/config_compilers.xml | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/config/cesm/machines/config_compilers.xml b/config/cesm/machines/config_compilers.xml index 9e61d46eb7f6..ca5eaffefcc6 100644 --- a/config/cesm/machines/config_compilers.xml +++ b/config/cesm/machines/config_compilers.xml @@ -915,6 +915,15 @@ using a fortran linker. + + + -lpthread + + + -L$(COMPILER_PATH)/lib/NAG_Fortran -lf62rts + + + -O0 From afafab38bcdd9250f08d5b96f2eeb703bd55a694 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 22 Apr 2019 16:25:04 -0600 Subject: [PATCH 41/54] more nag cleanup --- config/cesm/machines/config_compilers.xml | 33 ++++++++--------------- scripts/Tools/Makefile | 30 --------------------- 2 files changed, 11 insertions(+), 52 deletions(-) diff --git a/config/cesm/machines/config_compilers.xml b/config/cesm/machines/config_compilers.xml index ca5eaffefcc6..2e31bebc394d 100644 --- a/config/cesm/machines/config_compilers.xml +++ b/config/cesm/machines/config_compilers.xml @@ -320,6 +320,17 @@ using a fortran linker. mpif90 gcc nagfor + + + -lpthread + + + -L$(COMPILER_PATH)/lib/NAG_Fortran -lf62rts + + + LIBS="-L$(COMPILER_PATH)/lib/NAG_Fortran -lf62rts" + + @@ -902,28 +913,6 @@ using a fortran linker. /fs/cgd/csm/tools/pFUnit/pFUnit3.2.8_hobart_Intel15.0.2_noMPI_noOpenMP - - - - -DNO_C_SIZEOF - - - -lpthread - - - -L/usr/local/nag/lib/NAG_Fortran - - - - - - -lpthread - - - -L$(COMPILER_PATH)/lib/NAG_Fortran -lf62rts - - - -O0 diff --git a/scripts/Tools/Makefile b/scripts/Tools/Makefile index 58c1261e845a..b4ac9ff4aae7 100644 --- a/scripts/Tools/Makefile +++ b/scripts/Tools/Makefile @@ -439,32 +439,8 @@ endif ifeq ($(MODEL),driver) INCLDIR += -I$(EXEROOT)/atm/obj -I$(EXEROOT)/ice/obj -I$(EXEROOT)/ocn/obj -I$(EXEROOT)/glc/obj -I$(EXEROOT)/rof/obj -I$(EXEROOT)/wav/obj -I$(EXEROOT)/esp/obj -I$(EXEROOT)/iac/obj -# nagfor and gcc have incompatible LDFLAGS. -# nagfor requires the weird "-Wl,-Wl,," syntax. -# If done in config_compilers.xml, we break MCT. - ifeq ($(strip $(COMPILER)),nag) - ifeq ($(NETCDF_SEPARATE), FALSE) - SLIBS += -Wl,-Wl,,-rpath=$(LIB_NETCDF) - else ifeq ($(NETCDF_SEPARATE), TRUE) - SLIBS += -Wl,-Wl,,-rpath=$(LIB_NETCDF_C) - SLIBS += -Wl,-Wl,,-rpath=$(LIB_NETCDF_FORTRAN) - endif - endif -else - ifeq ($(strip $(COMPILER)),nag) - ifeq ($(DEBUG), TRUE) - ifeq ($(strip $(MACH)),hobart) - # GCC needs to be able to link to - # nagfor runtime to get autoconf - # tests to work. - CFLAGS += -Wl,--as-needed,--allow-shlib-undefined - SLIBS += -L$(COMPILER_PATH)/lib/NAG_Fortran -lf62rts - endif - endif - endif endif - ifndef MCT_LIBDIR MCT_LIBDIR=$(INSTALL_SHAREDPATH)/lib endif @@ -514,15 +490,9 @@ else ifeq ($(NETCDF_SEPARATE), TRUE) CONFIG_ARGS += NETCDF_PATH=$(NETCDF_C_PATH) endif -ifeq ($(COMPILER),nag) - CONFIG_ARGS += LIBS="$(SLIBS)" -endif - FFLAGS += $(FPPDEFS) FFLAGS_NOOPT += $(FPPDEFS) - - ifeq ($(findstring -cosp,$(CAM_CONFIG_OPTS)),-cosp) # The following is for the COSP simulator code: COSP_LIBDIR:=$(abspath $(EXEROOT)/atm/obj/cosp) From 94b8a2c183d643301ddfa175d63d73d4ca9b8108 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 23 Apr 2019 09:15:09 -0600 Subject: [PATCH 42/54] better setting for fclibs --- config/cesm/machines/config_compilers.xml | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/config/cesm/machines/config_compilers.xml b/config/cesm/machines/config_compilers.xml index 2e31bebc394d..826466cb5554 100644 --- a/config/cesm/machines/config_compilers.xml +++ b/config/cesm/machines/config_compilers.xml @@ -324,15 +324,12 @@ using a fortran linker. -lpthread - - -L$(COMPILER_PATH)/lib/NAG_Fortran -lf62rts - - LIBS="-L$(COMPILER_PATH)/lib/NAG_Fortran -lf62rts" + FCLIBS="-Wl,--as-needed,--allow-shlib-undefined -L$(COMPILER_PATH)/lib/NAG_Fortran -lf62rts" - + -gopt -time From ae2c333e9bbd0ac16c226e97ee3461ebb6240a2c Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 23 Apr 2019 09:47:20 -0600 Subject: [PATCH 43/54] fix format issue --- src/components/xcpl_comps/xshare/mct/dead_mod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/components/xcpl_comps/xshare/mct/dead_mod.F90 b/src/components/xcpl_comps/xshare/mct/dead_mod.F90 index c1cd1748c4eb..a0724fd27834 100644 --- a/src/components/xcpl_comps/xshare/mct/dead_mod.F90 +++ b/src/components/xcpl_comps/xshare/mct/dead_mod.F90 @@ -47,6 +47,7 @@ subroutine dead_read_inparms(model, mpicom, my_task, master_task, & !--- formats --- character(*), parameter :: F00 = "('(dead_read_inparms) ',8a)" character(*), parameter :: F01 = "('(dead_read_inparms) ',a,a,4i8)" + character(*), parameter :: F02 = "('(dead_read_inparms) ',a,L2)" character(*), parameter :: F03 = "('(dead_read_inparms) ',a,a,i8,a)" character(*), parameter :: subName = "(dead_read_inpamrs) " !------------------------------------------------------------------------------- @@ -95,7 +96,7 @@ subroutine dead_read_inparms(model, mpicom, my_task, master_task, & write(logunit,F00) model,' inst_name : ',trim(inst_name) write(logunit,F00) model,' inst_suffix : ',trim(inst_suffix) if (model.eq.'rof') then - write(logunit,F01) ' Flood mode : ',flood + write(logunit,F02) ' Flood mode : ',flood endif write(logunit,F00) model call shr_sys_flush(logunit) From bed3ac75253a82a513a859c1ec03da4cee801a0e Mon Sep 17 00:00:00 2001 From: Chris Fischer Date: Tue, 23 Apr 2019 11:53:37 -0600 Subject: [PATCH 44/54] Update ChangeLog for cime5.8.2 --- ChangeLog | 278 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 278 insertions(+) diff --git a/ChangeLog b/ChangeLog index 8a755f21a4f7..2a423ce6c64e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,283 @@ ====================================================================== +Originator: Chris Fischer +Date: 4-23-2019 +Tag: cime5.8.2 +Answer Changes: None +Tests: scripts_regression_tests +Dependencies: + +Brief Summary: + - Update the ne0CONUSne30x8 mapping files. + - Allow specific tests to ignore field list differences. + - Add NLDAS grid for CTSM and MOSART. + - Merge branch for acme split 2019-04-15 + - Fix unit test. + - Introduces a new stub IAC. + - Master merge to nuopc cmeps. + +User interface changes: + +PR summary: git log --oneline --first-parent [previous_tag]..master +57cf4a5 Merge pull request #3086 from ESMCI/fischer/ne_conus +421cc98 Merge pull request #3084 from billsacks/cprnc_ignore_fieldlist_diffs +a356310 Merge pull request #3063 from billsacks/nldas_grid_v2 +14babd5 Merge pull request #3079 from ESMCI/jgfouca/branch-for-acme-split-2019-04-15 +74730fe fix for unit test +4e86cc0 Merge pull request #3055 from bishtgautam/bishtgautam/iac +279d30a Merge pull request #3075 from jedwards4b/master-merge-to-nuopc-cmeps + + +Modified files: git diff --name-status [previous_tag] +M config/cesm/config_files.xml +M config/cesm/config_grids.xml +M config/cesm/config_grids_common.xml +M config/cesm/config_grids_mct.xml +M config/cesm/machines/config_machines.xml +M config/e3sm/allactive/config_compsets.xml +M config/e3sm/allactive/config_pesall.xml +M config/e3sm/config_archive.xml +M config/e3sm/config_files.xml +M config/e3sm/config_grids.xml +M config/e3sm/machines/config_batch.xml +M config/e3sm/machines/config_compilers.xml +M config/e3sm/machines/config_machines.xml +M config/e3sm/machines/config_pio.xml +M config/e3sm/tests.py +M config/xml_schemas/entry_id_base_version3.xsd +M scripts/Tools/Makefile +M scripts/Tools/archive_metadata +M scripts/Tools/case.build +M scripts/Tools/xmlconvertors/config_pes_converter.py +M scripts/Tools/xmlconvertors/grid_xml_converter.py +M scripts/lib/CIME/Servers/wget.py +M scripts/lib/CIME/SystemTests/system_tests_common.py +M scripts/lib/CIME/SystemTests/system_tests_compare_two.py +M scripts/lib/CIME/XML/grids.py +M scripts/lib/CIME/case/case.py +M scripts/lib/CIME/case/case_submit.py +M scripts/lib/CIME/hist_utils.py +M scripts/lib/CIME/tests/SystemTests/test_system_tests_compare_two.py +M src/components/data_comps/datm/nuopc/atm_comp_nuopc.F90 +M src/components/data_comps/datm/nuopc/datm_comp_mod.F90 +M src/components/data_comps/datm/nuopc/datm_shr_mod.F90 +M src/components/data_comps/dice/nuopc/dice_comp_mod.F90 +M src/components/data_comps/dice/nuopc/dice_shr_mod.F90 +M src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 +M src/components/data_comps/dlnd/nuopc/dlnd_comp_mod.F90 +M src/components/data_comps/dlnd/nuopc/dlnd_shr_mod.F90 +M src/components/data_comps/dlnd/nuopc/lnd_comp_nuopc.F90 +M src/components/data_comps/docn/nuopc/docn_comp_mod.F90 +M src/components/data_comps/docn/nuopc/docn_shr_mod.F90 +M src/components/data_comps/docn/nuopc/ocn_comp_nuopc.F90 +M src/components/data_comps/drof/nuopc/drof_comp_mod.F90 +M src/components/data_comps/drof/nuopc/rof_comp_nuopc.F90 +M src/components/data_comps/dshr_nuopc/dshr_nuopc_mod.F90 +M src/components/data_comps/dwav/nuopc/dwav_comp_mod.F90 +M src/components/data_comps/dwav/nuopc/dwav_shr_mod.F90 +M src/components/data_comps/dwav/nuopc/wav_comp_nuopc.F90 +A src/components/stub_comps/siac/cime_config/buildlib +A src/components/stub_comps/siac/cime_config/buildnml +A src/components/stub_comps/siac/cime_config/config_component.xml +A src/components/stub_comps/siac/mct/iac_comp_mct.F90 +M src/components/xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 +M src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 +M src/components/xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 +M src/components/xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 +M src/components/xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 +M src/components/xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 +M src/components/xcpl_comps/xshare/nuopc/dead_nuopc_mod.F90 +M src/components/xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 +M src/drivers/mct/cime_config/buildexe +M src/drivers/mct/cime_config/config_component.xml +M src/drivers/mct/cime_config/config_component_e3sm.xml +M src/drivers/mct/cime_config/config_compsets.xml +M src/drivers/mct/cime_config/config_pes.xml +M src/drivers/mct/cime_config/namelist_definition_drv.xml +M src/drivers/mct/cime_config/namelist_definition_modelio.xml +M src/drivers/mct/main/cime_comp_mod.F90 +M src/drivers/mct/main/component_mod.F90 +M src/drivers/mct/main/component_type_mod.F90 +M src/drivers/mct/main/prep_atm_mod.F90 +A src/drivers/mct/main/prep_iac_mod.F90 +M src/drivers/mct/main/prep_lnd_mod.F90 +M src/drivers/mct/main/seq_frac_mct.F90 +M src/drivers/mct/main/seq_hist_mod.F90 +M src/drivers/mct/main/seq_rest_mod.F90 +M src/drivers/mct/shr/seq_comm_mct.F90 +M src/drivers/mct/shr/seq_flds_mod.F90 +M src/drivers/mct/shr/seq_infodata_mod.F90 +M src/drivers/mct/shr/seq_timemgr_mod.F90 +M src/drivers/mct/unit_test/CMakeLists.txt +M src/drivers/nuopc/cime_config/buildnml +M src/drivers/nuopc/cime_config/config_component.xml +M src/drivers/nuopc/cime_config/config_component_cesm.xml +M src/drivers/nuopc/cime_config/nuopc_runseq_A +M src/drivers/nuopc/cime_config/nuopc_runseq_ADLND +M src/drivers/nuopc/cime_config/nuopc_runseq_ADWAV +M src/drivers/nuopc/cime_config/nuopc_runseq_B +D src/drivers/nuopc/cime_config/nuopc_runseq_C_G_D +A src/drivers/nuopc/cime_config/nuopc_runseq_C_G_D_swav +A src/drivers/nuopc/cime_config/nuopc_runseq_C_G_D_ww3 +A src/drivers/nuopc/cime_config/nuopc_runseq_C_wav +M src/drivers/nuopc/cime_config/nuopc_runseq_F +M src/drivers/nuopc/cime_config/nuopc_runseq_I +M src/drivers/nuopc/cime_config/nuopc_runseq_I_mosart +M src/drivers/nuopc/cime_config/nuopc_runseq_NEMS +A src/drivers/nuopc/cime_config/nuopc_runseq_NEMS.cold +A src/drivers/nuopc/cime_config/nuopc_runseq_NEMS.warm +M src/drivers/nuopc/cime_config/nuopc_runseq_Q +M src/drivers/nuopc/cime_config/nuopc_runseq_X +M src/drivers/nuopc/cime_config/nuopc_runseq_default +M src/drivers/nuopc/cime_driver/esmApp.F90 +M src/drivers/nuopc/cime_flds/esmFlds.F90 +M src/drivers/nuopc/cime_flds/esmFldsExchange.F90 +M src/drivers/nuopc/cime_flds/fd.yaml +M src/drivers/nuopc/cime_flds_shr/seq_drydep_mod.F90 +M src/drivers/nuopc/cime_flds_shr/shr_carma_mod.F90 +M src/drivers/nuopc/cime_flds_shr/shr_fire_emis_mod.F90 +M src/drivers/nuopc/cime_flds_shr/shr_megan_mod.F90 +M src/drivers/nuopc/cime_flds_shr/shr_ndep_mod.F90 +M src/drivers/nuopc/mediator/med.F90 +D src/drivers/nuopc/mediator/med_connectors_mod.F90 +M src/drivers/nuopc/mediator/med_fraction_mod.F90 +D src/drivers/nuopc/mediator/med_infodata_mod.F90 +M src/drivers/nuopc/mediator/med_internalstate_mod.F90 +M src/drivers/nuopc/mediator/med_io_mod.F90 +M src/drivers/nuopc/mediator/med_map_mod.F90 +M src/drivers/nuopc/mediator/med_merge_mod.F90 +M src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 +M src/drivers/nuopc/mediator/med_phases_history_mod.F90 +M src/drivers/nuopc/mediator/med_phases_ocnalb_mod.F90 +M src/drivers/nuopc/mediator/med_phases_prep_atm_mod.F90 +M src/drivers/nuopc/mediator/med_phases_prep_glc_mod.F90 +M src/drivers/nuopc/mediator/med_phases_prep_ice_mod.F90 +M src/drivers/nuopc/mediator/med_phases_prep_lnd_mod.F90 +M src/drivers/nuopc/mediator/med_phases_prep_ocn_mod.F90 +M src/drivers/nuopc/mediator/med_phases_prep_rof_mod.F90 +M src/drivers/nuopc/mediator/med_phases_prep_wav_mod.F90 +M src/drivers/nuopc/mediator/med_phases_restart_mod.F90 +M src/drivers/nuopc/shr/med_constants_mod.F90 +D src/drivers/nuopc/shr/shr_nuopc_grid_mod.F90 +M src/drivers/nuopc/shr/shr_nuopc_methods_mod.F90 +M src/drivers/nuopc/shr/shr_nuopc_utils_mod.F90 +M src/share/streams/shr_strdata_mod.F90 +M src/share/util/shr_pio_mod.F90 + +====================================================================== + +====================================================================== + +Originator: Chris Fischer +Date: 04-08-2019 +Tag: cime5.8.1 +Answer Changes: None +Tests: scripts_regression_tests, many create_newcase with mangled compset names + hand test xmllint +Dependencies: + +Brief Summary: + - Support optional components by filling in stub models for any missing component class + - Merge maint-5.6 branch. + - Fix issue with xmllint. + - Use installed pio libraries. + - Make FIELDLIST message more informative. + - ACME merge 2019-03-29 + - cprnc: allow differences in field lists for time-constant fields. + - Merge maint-5.6 branch. + - Add ne0CONUSne30x8_ne0CONUSne30x8_mg17 grid alias. + - Merge in latest nuopc-cmeps development. + - The check for an rpointer.drv file did not consider multidriver mode. + - Fix ./case.build --clean. + - PET and ERP tests were not setting compile_threaded correctly. + - Implement 'share' field of test suites. + +User interface changes: + - Stub components are now optional in compset long names. Also there is less order dependency. + +PR summary: git log --oneline --first-parent [previous_tag]..master +444b2f4 Merge pull request #3068 from gold2718/optional_components +c1a4c49 Merge branch 'maint-5.6' +150c2b5 Merge pull request #3061 from jedwards4b/fix_cesm_config_files +9b0be41 Merge pull request #3058 from jedwards4b/use_installed_libraries +ae332d4 Merge pull request #3059 from billsacks/fieldlist_differ_message +d94860f Merge pull request #3054 from ESMCI/jgfouca/branch-for-acme-split-2019-03-29 +95e117c Merge pull request #3051 from billsacks/cprnc_allow_timeconst_fielddiffs +338c143 Merge pull request #3052 from ESMCI/maint-5.6 +c82a5ee Merge pull request #3048 from ESMCI/fischer/SE_grids +1bb357c Merge pull request #3046 from jedwards4b/nuopc-cmeps +94d6da8 Merge pull request #3045 from jedwards4b/multi_driver_continue +9f5fb60 Merge pull request #3043 from ESMCI/jgfouca/fix_build_clean +ff06fd0 Merge pull request #3042 from ESMCI/jedwards/pet_test_fix +bafad7e Merge pull request #3040 from ESMCI/jgfouca/impl_share_field + + +Modified files: git diff --name-status [previous_tag] +M config/cesm/config_files.xml +M config/cesm/config_grids.xml +M config/cesm/machines/config_compilers.xml +M config/cesm/machines/config_machines.xml +M config/cesm/machines/userdefined_laptop_template/config_compilers.xml +M config/e3sm/config_grids.xml +M config/e3sm/config_inputdata.xml +M config/e3sm/machines/Depends.cetus +M config/e3sm/machines/Depends.mira +M config/e3sm/machines/Depends.summit.ibm +M config/e3sm/machines/Depends.summitdev.ibm +M config/e3sm/machines/config_batch.xml +M config/e3sm/machines/config_compilers.xml +M config/e3sm/machines/config_machines.xml +M config/e3sm/machines/config_pio.xml +M config/e3sm/machines/userdefined_laptop_template/config_compilers.xml +M config/e3sm/tests.py +M config/xml_schemas/config_batch.xsd +M config/xml_schemas/config_compilers_v2.xsd +M config/xml_schemas/config_machines.xsd +M config/xml_schemas/env_mach_specific.xsd +M doc/source/users_guide/cime-config.rst +M doc/source/users_guide/unit_testing.rst +M scripts/Tools/Makefile +M scripts/create_test +M scripts/fortran_unit_testing/run_tests.py +M scripts/lib/CIME/BuildTools/configure.py +M scripts/lib/CIME/BuildTools/valuesetting.py +M scripts/lib/CIME/XML/entry_id.py +M scripts/lib/CIME/XML/generic_xml.py +M scripts/lib/CIME/build.py +M scripts/lib/CIME/case/case.py +M scripts/lib/CIME/case/case_submit.py +M scripts/lib/CIME/case/check_input_data.py +M scripts/lib/CIME/hist_utils.py +M scripts/lib/CIME/test_scheduler.py +M scripts/lib/get_tests.py +M scripts/tests/scripts_regression_tests.py +M src/build_scripts/buildlib.gptl +M src/build_scripts/buildlib.kokkos +M src/build_scripts/buildlib.pio +M src/components/data_comps/datm/cime_config/config_component.xml +M src/components/data_comps/datm/nuopc/datm_comp_mod.F90 +M src/components/data_comps/desp/cime_config/config_component.xml +M src/drivers/mct/cime_config/namelist_definition_drv.xml +M src/drivers/mct/main/seq_flux_mct.F90 +M src/drivers/mct/shr/seq_infodata_mod.F90 +M src/share/util/shr_flux_mod.F90 +M tools/cprnc/README +M tools/cprnc/compare_vars_mod.F90.in +M tools/cprnc/cprnc.F90 +M tools/cprnc/filestruct.F90 +M tools/cprnc/run_tests +M tools/cprnc/test_inputs/README +A tools/cprnc/test_inputs/multipleTimes_someTimeless_extra_and_missing.nc +A tools/cprnc/test_inputs/noTime_extra_and_missing.nc +M tools/mapping/gen_domain_files/README +M tools/mapping/gen_domain_files/src/gen_domain.F90 +M tools/mapping/gen_mapping_files/runoff_to_ocn/src/Makefile + +====================================================================== + + +====================================================================== + Originator: Chris Fischer Date: 03-12-2019 Tag: cime5.8.0 From 73d9031b91b86c17dbe1d709986a200d692c1f2f Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 23 Apr 2019 12:33:49 -0600 Subject: [PATCH 45/54] adjust batch setting for izumi --- config/cesm/machines/config_batch.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/config/cesm/machines/config_batch.xml b/config/cesm/machines/config_batch.xml index 46d7f94c4dd3..4fac63301ee3 100644 --- a/config/cesm/machines/config_batch.xml +++ b/config/cesm/machines/config_batch.xml @@ -402,6 +402,7 @@ ssh izumi cd $CASEROOT ; qsub + (\d+.izumi.unified.ucar.edu)$ -l nodes={{ num_nodes }}:ppn={{ tasks_per_node }} -S {{ shell }} From 2dd01aac401dcb96d02f8738b43cfa9fc5cce9af Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 24 Apr 2019 10:21:28 -0600 Subject: [PATCH 46/54] update intel compiler for cheyenne --- config/cesm/machines/config_machines.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config/cesm/machines/config_machines.xml b/config/cesm/machines/config_machines.xml index 956fdd1531b6..343750a56926 100644 --- a/config/cesm/machines/config_machines.xml +++ b/config/cesm/machines/config_machines.xml @@ -353,7 +353,7 @@ This allows using a different mpirun command to launch unit tests ncarenv/1.2 - intel/17.0.1 + intel/19.0.2 esmf_libs mkl From f262b35af5025e399db9cac02980717b04e3bc5b Mon Sep 17 00:00:00 2001 From: James Foucar Date: Wed, 24 Apr 2019 10:43:50 -0600 Subject: [PATCH 47/54] Update CIME to ESMCI cime5.8.2 (#2876) Update CIME to ESMCI cime5.8.2 Squash merge of jgfouca/branch-for-to-acme-2019-04-22 Features: * Adds a stub for Integrated Assessment Component (IAC) * Allow specific tests to ignore field list differences Bug fixes: * Minor [BFB] --- config/cesm/config_files.xml | 26 + config/cesm/config_grids.xml | 51 +- config/cesm/config_grids_common.xml | 36 +- config/cesm/config_grids_mct.xml | 32 +- config/cesm/machines/config_machines.xml | 4 +- config/e3sm/allactive/config_pesall.xml | 2 +- config/e3sm/config_files.xml | 13 + config/e3sm/config_grids.xml | 1 + config/xml_schemas/entry_id_base_version3.xsd | 2 +- scripts/Tools/Makefile | 36 +- scripts/Tools/archive_metadata | 2 +- scripts/Tools/case.build | 2 +- .../xmlconvertors/config_pes_converter.py | 8 +- .../Tools/xmlconvertors/grid_xml_converter.py | 2 +- .../CIME/SystemTests/system_tests_common.py | 28 +- .../SystemTests/system_tests_compare_two.py | 13 +- scripts/lib/CIME/XML/grids.py | 6 +- scripts/lib/CIME/case/case.py | 38 +- scripts/lib/CIME/case/case_submit.py | 2 +- scripts/lib/CIME/hist_utils.py | 29 +- .../test_system_tests_compare_two.py | 2 +- .../data_comps/datm/nuopc/atm_comp_nuopc.F90 | 105 +- .../data_comps/datm/nuopc/datm_comp_mod.F90 | 515 +++++-- .../data_comps/datm/nuopc/datm_shr_mod.F90 | 6 +- .../data_comps/dice/nuopc/dice_comp_mod.F90 | 278 +++- .../data_comps/dice/nuopc/dice_shr_mod.F90 | 6 +- .../data_comps/dice/nuopc/ice_comp_nuopc.F90 | 71 +- .../data_comps/dlnd/nuopc/dlnd_comp_mod.F90 | 168 +- .../data_comps/dlnd/nuopc/dlnd_shr_mod.F90 | 6 +- .../data_comps/dlnd/nuopc/lnd_comp_nuopc.F90 | 100 +- .../data_comps/docn/nuopc/docn_comp_mod.F90 | 203 ++- .../data_comps/docn/nuopc/docn_shr_mod.F90 | 18 +- .../data_comps/docn/nuopc/ocn_comp_nuopc.F90 | 173 +-- .../data_comps/drof/nuopc/drof_comp_mod.F90 | 29 +- .../data_comps/drof/nuopc/rof_comp_nuopc.F90 | 21 +- .../data_comps/dshr_nuopc/dshr_nuopc_mod.F90 | 293 ++-- .../data_comps/dwav/nuopc/dwav_comp_mod.F90 | 93 +- .../data_comps/dwav/nuopc/dwav_shr_mod.F90 | 8 +- .../data_comps/dwav/nuopc/wav_comp_nuopc.F90 | 109 +- .../stub_comps/siac/cime_config/buildlib | 1 + .../stub_comps/siac/cime_config/buildnml | 7 + .../siac/cime_config/config_component.xml | 26 + .../stub_comps/siac/mct/iac_comp_mct.F90 | 114 ++ .../xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 | 322 ++-- .../xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 | 277 ++-- .../xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 | 249 +-- .../xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 | 253 +-- .../xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 | 224 +-- .../xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 | 211 ++- .../xshare/nuopc/dead_nuopc_mod.F90 | 711 ++++----- .../xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 | 250 +-- src/drivers/mct/cime_config/buildexe | 5 + .../mct/cime_config/config_component.xml | 125 +- .../mct/cime_config/config_component_e3sm.xml | 9 + .../mct/cime_config/config_compsets.xml | 3 +- src/drivers/mct/cime_config/config_pes.xml | 9 +- .../cime_config/namelist_definition_drv.xml | 259 ++++ .../namelist_definition_modelio.xml | 6 + src/drivers/mct/main/cime_comp_mod.F90 | 284 +++- src/drivers/mct/main/component_mod.F90 | 15 +- src/drivers/mct/main/component_type_mod.F90 | 5 +- src/drivers/mct/main/prep_atm_mod.F90 | 26 +- src/drivers/mct/main/prep_iac_mod.F90 | 168 ++ src/drivers/mct/main/prep_lnd_mod.F90 | 31 +- src/drivers/mct/main/seq_frac_mct.F90 | 39 +- src/drivers/mct/main/seq_hist_mod.F90 | 83 +- src/drivers/mct/main/seq_rest_mod.F90 | 31 +- src/drivers/mct/shr/seq_comm_mct.F90 | 31 +- src/drivers/mct/shr/seq_flds_mod.F90 | 5 + src/drivers/mct/shr/seq_infodata_mod.F90 | 122 +- src/drivers/mct/shr/seq_timemgr_mod.F90 | 61 +- src/drivers/mct/unit_test/CMakeLists.txt | 1 + src/drivers/nuopc/cime_config/buildnml | 19 +- .../nuopc/cime_config/config_component.xml | 9 - .../cime_config/config_component_cesm.xml | 4 +- src/drivers/nuopc/cime_config/nuopc_runseq_A | 8 - .../nuopc/cime_config/nuopc_runseq_ADLND | 1 - .../nuopc/cime_config/nuopc_runseq_ADWAV | 1 - src/drivers/nuopc/cime_config/nuopc_runseq_B | 8 - .../nuopc/cime_config/nuopc_runseq_C_G_D_swav | 27 + .../nuopc/cime_config/nuopc_runseq_C_G_D_ww3 | 31 + .../nuopc/cime_config/nuopc_runseq_C_wav | 31 + src/drivers/nuopc/cime_config/nuopc_runseq_F | 8 - src/drivers/nuopc/cime_config/nuopc_runseq_I | 3 - .../nuopc/cime_config/nuopc_runseq_I_mosart | 7 +- .../nuopc/cime_config/nuopc_runseq_NEMS | 6 - .../nuopc/cime_config/nuopc_runseq_NEMS.cold | 26 + .../nuopc/cime_config/nuopc_runseq_NEMS.warm | 26 + src/drivers/nuopc/cime_config/nuopc_runseq_Q | 4 - src/drivers/nuopc/cime_config/nuopc_runseq_X | 14 - .../nuopc/cime_config/nuopc_runseq_default | 14 - src/drivers/nuopc/cime_driver/esmApp.F90 | 44 +- src/drivers/nuopc/cime_flds/esmFlds.F90 | 13 +- .../nuopc/cime_flds/esmFldsExchange.F90 | 1000 ++++++------ src/drivers/nuopc/cime_flds/fd.yaml | 1371 +++-------------- .../nuopc/cime_flds_shr/seq_drydep_mod.F90 | 94 +- .../nuopc/cime_flds_shr/shr_carma_mod.F90 | 28 +- .../nuopc/cime_flds_shr/shr_fire_emis_mod.F90 | 155 +- .../nuopc/cime_flds_shr/shr_megan_mod.F90 | 204 ++- .../nuopc/cime_flds_shr/shr_ndep_mod.F90 | 51 +- src/drivers/nuopc/mediator/med.F90 | 416 ++--- .../nuopc/mediator/med_fraction_mod.F90 | 66 +- .../nuopc/mediator/med_internalstate_mod.F90 | 11 +- src/drivers/nuopc/mediator/med_io_mod.F90 | 700 ++++++--- src/drivers/nuopc/mediator/med_map_mod.F90 | 481 +++--- src/drivers/nuopc/mediator/med_merge_mod.F90 | 125 +- .../mediator/med_phases_aofluxes_mod.F90 | 236 +-- .../nuopc/mediator/med_phases_history_mod.F90 | 15 +- .../nuopc/mediator/med_phases_ocnalb_mod.F90 | 41 +- .../mediator/med_phases_prep_atm_mod.F90 | 37 +- .../mediator/med_phases_prep_glc_mod.F90 | 78 +- .../mediator/med_phases_prep_ice_mod.F90 | 320 ++-- .../mediator/med_phases_prep_lnd_mod.F90 | 95 +- .../mediator/med_phases_prep_ocn_mod.F90 | 140 +- .../mediator/med_phases_prep_rof_mod.F90 | 83 +- .../mediator/med_phases_prep_wav_mod.F90 | 259 ++-- .../nuopc/mediator/med_phases_restart_mod.F90 | 10 +- src/drivers/nuopc/shr/med_constants_mod.F90 | 2 +- .../nuopc/shr/shr_nuopc_methods_mod.F90 | 976 +++++++----- src/drivers/nuopc/shr/shr_nuopc_utils_mod.F90 | 60 +- 120 files changed, 7759 insertions(+), 6099 deletions(-) create mode 120000 src/components/stub_comps/siac/cime_config/buildlib create mode 100755 src/components/stub_comps/siac/cime_config/buildnml create mode 100644 src/components/stub_comps/siac/cime_config/config_component.xml create mode 100644 src/components/stub_comps/siac/mct/iac_comp_mct.F90 create mode 100644 src/drivers/mct/main/prep_iac_mod.F90 create mode 100644 src/drivers/nuopc/cime_config/nuopc_runseq_C_G_D_swav create mode 100644 src/drivers/nuopc/cime_config/nuopc_runseq_C_G_D_ww3 create mode 100644 src/drivers/nuopc/cime_config/nuopc_runseq_C_wav create mode 100644 src/drivers/nuopc/cime_config/nuopc_runseq_NEMS.cold create mode 100644 src/drivers/nuopc/cime_config/nuopc_runseq_NEMS.warm diff --git a/config/cesm/config_files.xml b/config/cesm/config_files.xml index 5fd586014c05..9ff04054c793 100644 --- a/config/cesm/config_files.xml +++ b/config/cesm/config_files.xml @@ -212,6 +212,19 @@ $CIMEROOT/config/xml_schemas/config_compsets.xsd + + char + unset + + $CIMEROOT/src/components/stub_comps/siac + $CIMEROOT/src/components/xcpl_comps/xiac + + case_comps + env_case.xml + Root directory of the case integrated assessment component + $CIMEROOT/config/xml_schemas/config_compsets.xsd + + char unset @@ -502,6 +515,19 @@ $CIMEROOT/config/xml_schemas/entry_id_version3.xsd + + char + unset + + $COMP_ROOT_DIR_IAC/cime_config/config_component.xml + + case_last + env_case.xml + file containing specification of component specific definitions and values(for documentation only - DO NOT EDIT) + $CIMEROOT/config/xml_schemas/entry_id.xsd + $CIMEROOT/config/xml_schemas/entry_id_version3.xsd + + char diff --git a/config/cesm/config_grids.xml b/config/cesm/config_grids.xml index 11d501bb4ba9..e90801e62f0e 100644 --- a/config/cesm/config_grids.xml +++ b/config/cesm/config_grids.xml @@ -44,6 +44,7 @@ ww3a ww3a ww3a + null @@ -120,6 +121,16 @@ null + + + 0.125nldas2 + 0.125nldas2 + 0.125nldas2 + 0.125nldas2 + nldas2 + + 360x720cru 360x720cru @@ -277,6 +288,12 @@ tx0.66v1 + + T62 + T62 + tx0.25v1 + + T62 T62 @@ -1002,11 +1019,11 @@ tx0.66v1 - + C96 C96 - tx0.66v1 - tx0.66v1 + tx0.25v1 + tx0.25v1 @@ -1093,6 +1110,14 @@ 5x5 Amazon regional case -- only valid for DATM/CLM compset + + + 464 224 + $DIN_LOC_ROOT/share/domains/domain.clm/domain.lnd.0.125nldas2_0.125nldas2.190410.nc + $DIN_LOC_ROOT/share/domains/domain.clm/domain.ocn.0.125nldas2.190410.nc + Regional NLDAS-2 grid over the U.S. (0.125 degree resolution; 25-53N, 235-293E) + + @@ -1367,8 +1392,8 @@ 174098 1 - $DIN_LOC_ROOT/share/domains/domain.lnd.ne0CONUSne30x8_gx1v7.190304.nc - $DIN_LOC_ROOT/share/domains/domain.ocn.ne0CONUSne30x8_gx1v7.190304.nc + $DIN_LOC_ROOT/share/domains/domain.lnd.ne0CONUSne30x8_gx1v7.190322.nc + $DIN_LOC_ROOT/share/domains/domain.ocn.ne0CONUSne30x8_gx1v7.190322.nc ne0np4CONUS.ne30x8 is a Spectral Elem 1-deg grid with a 1/8 deg refined region over the continental United States: Test support only @@ -1400,7 +1425,9 @@ EXPERIMENTAL FVM physics grid + + 320 384 @@ -1433,6 +1460,14 @@ Experimental for MOM6 experiments + + 1440 1080 + $DIN_LOC_ROOT/share/domains/domain.ocn.tx0.25v1.190207.nc + $DIN_LOC_ROOT/share/meshes/tx0.25v1_190204_ESMFmesh.nc + tx0.25v1 is tripole v1 0.25-deg MOM6 grid: + Experimental for MOM6 experiments + + 3600 2400 $DIN_LOC_ROOT/share/domains/domain.ocn.tx0.1v2.161014.nc @@ -1461,7 +1496,9 @@ Experimental, under development + + 360 180 @@ -1554,8 +1591,8 @@ OCN2WAV_SMAPNAME ICE2WAV_SMAPNAME - ROF2OCN_LIQ_RMAPNAME - ROF2OCN_ICE_RMAPNAME + ROF2OCN_LIQ_RMAPNAME + ROF2OCN_ICE_RMAPNAME LND2ROF_FMAPNAME ROF2LND_FMAPNAME diff --git a/config/cesm/config_grids_common.xml b/config/cesm/config_grids_common.xml index 82f9d56a0dc2..2f41b5b07333 100644 --- a/config/cesm/config_grids_common.xml +++ b/config/cesm/config_grids_common.xml @@ -1,6 +1,7 @@ + @@ -31,8 +32,8 @@ - cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_0.5x0.5_nomask_aave.190227.nc - cpl/gridmaps/ne0np4CONUS.ne30x8/map_0.5x0.5_nomask_TO_ne0CONUSne30x8_aave.190227.nc + cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_0.5x0.5_nomask_aave.190322.nc + cpl/gridmaps/ne0np4CONUS.ne30x8/map_0.5x0.5_nomask_TO_ne0CONUSne30x8_aave.190322.nc @@ -287,10 +288,10 @@ - cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_gland4km_aave.190227.nc - cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_gland4km_blin.190227.nc - cpl/gridmaps/gland4km/map_gland4km_TO_ne0CONUSne30x8_aave.190227.nc - cpl/gridmaps/gland4km/map_gland4km_TO_ne0CONUSne30x8_aave.190227.nc + cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_gland4km_aave.190322.nc + cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_gland4km_blin.190322.nc + cpl/gridmaps/gland4km/map_gland4km_TO_ne0CONUSne30x8_aave.190322.nc + cpl/gridmaps/gland4km/map_gland4km_TO_ne0CONUSne30x8_aave.190322.nc @@ -459,7 +460,6 @@ cpl/gridmaps/gland4km/map_gland4km_to_gx3v7_nnsm_e1000r500_180502.nc cpl/gridmaps/gland4km/map_gland4km_to_gx3v7_nnsm_e1000r500_180502.nc - cpl/gridmaps/gland5km/map_gland5km_to_gx1v6_nn_open_ocean_nnsm_e1000r300_marginal_sea_171105.nc cpl/gridmaps/gland5km/map_gland5km_to_gx1v6_nnsm_e1000r300_171105.nc @@ -490,4 +490,26 @@ cpl/gridmaps/gland20km/map_gland20km_to_gx3v7_nnsm_e1000r500_180502.nc + + + + + + cpl/gridmaps/ww3a/map_ww3a_TO_gx3v7_splice_150428.nc + cpl/gridmaps/gx3v7/map_gx3v7_TO_ww3a_splice_150428.nc + cpl/gridmaps/gx3v7/map_gx3v7_TO_ww3a_splice_150428.nc + + + + cpl/gridmaps/ww3a/map_ww3a_TO_gx1v6_splice_150428.nc + cpl/gridmaps/gx1v6/map_gx1v6_TO_ww3a_splice_150428.nc + cpl/gridmaps/gx1v6/map_gx1v6_TO_ww3a_splice_150428.nc + + + + cpl/gridmaps/ww3a/map_ww3a_TO_gx1v7_splice_170214.nc + cpl/gridmaps/gx1v7/map_gx1v7_TO_ww3a_splice_170214.nc + cpl/gridmaps/gx1v7/map_gx1v7_TO_ww3a_splice_170214.nc + + diff --git a/config/cesm/config_grids_mct.xml b/config/cesm/config_grids_mct.xml index c7e4abc0eda2..6066cd95e402 100644 --- a/config/cesm/config_grids_mct.xml +++ b/config/cesm/config_grids_mct.xml @@ -75,6 +75,7 @@ cpl/gridmaps/gx1v6/map_gx1v6_TO_fv1.9x2.5_aave.130322.nc cpl/gridmaps/gx1v6/map_gx1v6_TO_fv1.9x2.5_aave.130322.nc + cpl/gridmaps/fv1.9x2.5/map_fv1.9x2.5_TO_gx1v7_aave.181205.nc cpl/gridmaps/fv1.9x2.5/map_fv1.9x2.5_TO_gx1v7_blin.181205.nc @@ -82,6 +83,7 @@ cpl/gridmaps/gx1v7/map_gx1v7_TO_fv1.9x2.5_aave.181205.nc cpl/gridmaps/gx1v7/map_gx1v7_TO_fv1.9x2.5_aave.181205.nc + cpl/cpl6/map_fv1.9x2.5_to_tx1v1_aave_da_090710.nc cpl/cpl6/map_fv1.9x2.5_to_tx1v1_bilin_da_090710.nc @@ -206,15 +208,15 @@ - cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_gx1v7_aave.190227.nc - cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_gx1v7_blin.190227.nc - cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_gx1v7_patc.190227.nc - cpl/gridmaps/gx1v7/map_gx1v7_TO_ne0CONUSne30x8_aave.190227.nc - cpl/gridmaps/gx1v7/map_gx1v7_TO_ne0CONUSne30x8_aave.190227.nc + cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_gx1v7_aave.190322.nc + cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_gx1v7_blin.190322.nc + cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_gx1v7_patc.190322.nc + cpl/gridmaps/gx1v7/map_gx1v7_TO_ne0CONUSne30x8_aave.190322.nc + cpl/gridmaps/gx1v7/map_gx1v7_TO_ne0CONUSne30x8_aave.190322.nc - cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_ww3a_blin.190213.nc + cpl/gridmaps/ne0np4CONUS.ne30x8/map_ne0CONUSne30x8_TO_ww3a_blin.190322.nc @@ -349,24 +351,6 @@ - - cpl/gridmaps/ww3a/map_ww3a_TO_gx3v7_splice_150428.nc - cpl/gridmaps/gx3v7/map_gx3v7_TO_ww3a_splice_150428.nc - cpl/gridmaps/gx3v7/map_gx3v7_TO_ww3a_splice_150428.nc - - - - cpl/gridmaps/ww3a/map_ww3a_TO_gx1v6_splice_150428.nc - cpl/gridmaps/gx1v6/map_gx1v6_TO_ww3a_splice_150428.nc - cpl/gridmaps/gx1v6/map_gx1v6_TO_ww3a_splice_150428.nc - - - - cpl/gridmaps/ww3a/map_ww3a_TO_gx1v7_splice_170214.nc - cpl/gridmaps/gx1v7/map_gx1v7_TO_ww3a_splice_170214.nc - cpl/gridmaps/gx1v7/map_gx1v7_TO_ww3a_splice_170214.nc - - cpl/gridmaps/ww3a/map_ww3a_TO_tx1v1_blin.170523.nc cpl/gridmaps/tx1v1/map_tx1v1_TO_ww3a_blin.170523.nc diff --git a/config/cesm/machines/config_machines.xml b/config/cesm/machines/config_machines.xml index 10180ba10bb1..956fdd1531b6 100644 --- a/config/cesm/machines/config_machines.xml +++ b/config/cesm/machines/config_machines.xml @@ -2309,7 +2309,7 @@ This allows using a different mpirun command to launch unit tests - /home1/06242/tg855414/ESMF-INSTALL/master/lib/libg/Linux.intel.64.intelmpi.default/esmf.mk + /work/06242/tg855414/stampede2/ESMF-INSTALL/8.0.0bs28/lib/libO/Linux.intel.64.intelmpi.default/esmf.mk ON @@ -2421,7 +2421,7 @@ This allows using a different mpirun command to launch unit tests netcdf/4.3.0 pnetcdf /scratch4/NCEPDEV/nems/noscrub/emc.nemspara/soft/modulefiles - esmf/8.0.0bs27g + esmf/8.0.0bs28g diff --git a/config/e3sm/allactive/config_pesall.xml b/config/e3sm/allactive/config_pesall.xml index a18ae8c60ab1..52a3d285dc9b 100644 --- a/config/e3sm/allactive/config_pesall.xml +++ b/config/e3sm/allactive/config_pesall.xml @@ -1237,7 +1237,7 @@ - + none diff --git a/config/e3sm/config_files.xml b/config/e3sm/config_files.xml index f1476c4c0d61..738514de3305 100644 --- a/config/e3sm/config_files.xml +++ b/config/e3sm/config_files.xml @@ -365,6 +365,19 @@ $CIMEROOT/config/xml_schemas/entry_id_version3.xsd + + char + unset + + $CIMEROOT/src/components/stub_comps/siac/cime_config/config_component.xml + + case_last + env_case.xml + file containing specification of component specific definitions and values(for documentation only - DO NOT EDIT) + $CIMEROOT/config/xml_schemas/entry_id.xsd + $CIMEROOT/config/xml_schemas/entry_id_version3.xsd + + char unset diff --git a/config/e3sm/config_grids.xml b/config/e3sm/config_grids.xml index 6040eb0cf14b..49b3615d54b4 100644 --- a/config/e3sm/config_grids.xml +++ b/config/e3sm/config_grids.xml @@ -45,6 +45,7 @@ ww3a ww3a ww3a + null diff --git a/config/xml_schemas/entry_id_base_version3.xsd b/config/xml_schemas/entry_id_base_version3.xsd index a173554a5bdb..f4599927e9e1 100644 --- a/config/xml_schemas/entry_id_base_version3.xsd +++ b/config/xml_schemas/entry_id_base_version3.xsd @@ -40,7 +40,7 @@ - + diff --git a/scripts/Tools/Makefile b/scripts/Tools/Makefile index aaf7e8bb1b64..4e54e28046e1 100644 --- a/scripts/Tools/Makefile +++ b/scripts/Tools/Makefile @@ -91,7 +91,9 @@ include $(CASEROOT)/Macros.make # Unless DEBUG mode is enabled, use NDEBUG to turn off assert statements. ifeq ($(strip $(DEBUG)),TRUE) - #CPPDEFS += -DDEBUG + ifeq ($(CIME_MODEL),cesm) + CPPDEFS += -DDEBUG + endif else CPPDEFS += -DNDEBUG endif @@ -103,14 +105,6 @@ endif ifeq ($(COMP_INTERFACE), nuopc) CPPDEFS += -DNUOPC_INTERFACE - CPPDEFS += -DESMFUSE_$(COMP_ATM) - CPPDEFS += -DESMFUSE_$(COMP_LND) - CPPDEFS += -DESMFUSE_$(COMP_OCN) - CPPDEFS += -DESMFUSE_$(COMP_ICE) - CPPDEFS += -DESMFUSE_$(COMP_ROF) - CPPDEFS += -DESMFUSE_$(COMP_WAV) - CPPDEFS += -DESMFUSE_$(COMP_GLC) - CPPDEFS += -DESMFUSE_$(COMP_ESP) else CPPDEFS += -DMCT_INTERFACE endif @@ -136,12 +130,6 @@ ifeq (,$(SHAREDPATH)) INSTALL_SHAREDPATH = $(EXEROOT)/$(SHAREDPATH) endif -include $(CASEROOT)/Macros.make - -ifeq ($(strip $(USE_FMS)), TRUE) - SLIBS += -lfms -endif - # Decide whether to use a C++ or Fortran linker, based on whether we # are using any C++ code and the compiler-dependent CXX_LINKER variable ifeq ($(USE_CXX), TRUE) @@ -301,6 +289,10 @@ ifeq ($(strip $(USE_KOKKOS)), TRUE) CXX_LDFLAGS += $(KOKKOS_LDFLAGS) endif +ifeq ($(strip $(USE_FMS)), TRUE) + SLIBS += -lfms +endif + # Set MOAB info if it is being used ifeq ($(strip $(USE_MOAB)), TRUE) ifdef MOAB_PATH @@ -454,7 +446,7 @@ ifdef INC_MOAB endif ifeq ($(MODEL),driver) - INCLDIR += -I$(EXEROOT)/atm/obj -I$(EXEROOT)/ice/obj -I$(EXEROOT)/ocn/obj -I$(EXEROOT)/glc/obj -I$(EXEROOT)/rof/obj -I$(EXEROOT)/wav/obj -I$(EXEROOT)/esp/obj + INCLDIR += -I$(EXEROOT)/atm/obj -I$(EXEROOT)/ice/obj -I$(EXEROOT)/ocn/obj -I$(EXEROOT)/glc/obj -I$(EXEROOT)/rof/obj -I$(EXEROOT)/wav/obj -I$(EXEROOT)/esp/obj -I$(EXEROOT)/iac/obj # nagfor and gcc have incompatible LDFLAGS. # nagfor requires the weird "-Wl,-Wl,," syntax. # If done in config_compilers.xml, we break MCT. @@ -848,6 +840,7 @@ ifeq ($(ULIBDEP),$(null)) ULIBDEP += $(LIBROOT)/librof.a ULIBDEP += $(LIBROOT)/libglc.a ULIBDEP += $(LIBROOT)/libwav.a + ULIBDEP += $(LIBROOT)/libiac.a ULIBDEP += $(LIBROOT)/libesp.a ifeq ($(COMP_GLC), cism) ULIBDEP += $(CISM_LIBDIR)/libglimmercismfortran.a @@ -946,6 +939,9 @@ clean_dependsocn: clean_dependswav: $(RM) -f $(EXEROOT)/wav/obj/Srcfiles +clean_dependsiac: + $(RM) -f $(EXEROOT)/iac/obj/Srcfiles + clean_dependsglc: $(RM) -f $(EXEROOT)/glc/obj/Srcfiles @@ -964,7 +960,7 @@ clean_dependslnd: clean_dependscsmshare: $(RM) -f $(SHAREDLIBROOT)/$(SHAREDPATH)/$(COMP_INTERFACE)/$(ESMFDIR)/$(NINST_VALUE)/csm_share/Srcfiles -clean_depends: clean_dependsatm clean_dependscpl clean_dependswav clean_dependsglc clean_dependsice clean_dependsrof clean_dependslnd clean_dependscsmshare clean_dependsesp +clean_depends: clean_dependsatm clean_dependscpl clean_dependswav clean_dependsglc clean_dependsice clean_dependsrof clean_dependslnd clean_dependscsmshare clean_dependsesp clean_dependsiac cleanatm: @@ -982,6 +978,10 @@ cleanwav: $(RM) -f $(LIBROOT)/libwav.a $(RM) -fr $(EXEROOT)/wav/obj +cleaniac: + $(RM) -f $(LIBROOT)/libiac.a + $(RM) -fr $(EXEROOT)/iac/obj + cleanesp: $(RM) -f $(LIBROOT)/libesp.a $(RM) -fr $(EXEROOT)/esp/obj @@ -1018,7 +1018,7 @@ cleangptl: $(RM) -f $(GPTLLIB) $(RM) -fr $(SHAREDLIBROOT)/$(SHAREDPATH)/gptl -clean: cleanatm cleanocn cleanwav cleanglc cleanice cleanrof cleanlnd cleanesp +clean: cleanatm cleanocn cleanwav cleanglc cleanice cleanrof cleanlnd cleanesp cleaniac realclean: clean cleancsmshare cleanpio cleanmct cleangptl diff --git a/scripts/Tools/archive_metadata b/scripts/Tools/archive_metadata index 85f4930b7ec8..8114a3eaf40e 100755 --- a/scripts/Tools/archive_metadata +++ b/scripts/Tools/archive_metadata @@ -565,7 +565,7 @@ def get_case_status(case_dict): # exclude the proc directories in the sta size estimates for subdir in ['atm/hist', 'cpl/hist', 'esp/hist', 'ice/hist', 'glc/hist', 'lnd/hist', 'logs', 'ocn/hist', 'rest', 'rof/hist', - 'wav/hist']: + 'wav/hist', 'iac/hist']: path = os.path.join(case_dict['sta_path'], subdir) if os.path.isdir(path): case_dict['sta_size'] += get_disk_usage(path) diff --git a/scripts/Tools/case.build b/scripts/Tools/case.build index 00573d4b8dc9..162fd6123f84 100755 --- a/scripts/Tools/case.build +++ b/scripts/Tools/case.build @@ -69,7 +69,7 @@ def parse_command_line(args, description): # config_file = files.get_value("CONFIG_CPL_FILE") # component = Component(config_file, "CPL") # comps = [x.lower() for x in component.get_valid_model_components()] - comps = ["cpl","atm","lnd","ice","ocn","rof","glc","wav","esp"] + comps = ["cpl","atm","lnd","ice","ocn","rof","glc","wav","esp","iac"] libs = ["csmshare", "mct", "pio", "gptl"] allobjs = comps + libs diff --git a/scripts/Tools/xmlconvertors/config_pes_converter.py b/scripts/Tools/xmlconvertors/config_pes_converter.py index 2a6333654005..a02bf7cfab0a 100755 --- a/scripts/Tools/xmlconvertors/config_pes_converter.py +++ b/scripts/Tools/xmlconvertors/config_pes_converter.py @@ -74,7 +74,7 @@ def to_cime5(self): commentnode.text = "none" for d in ['ntasks', 'nthrds', 'rootpe']: newnode = ET.SubElement(pesnode, d) - for comp in ['atm', 'lnd', 'rof', 'ice', 'ocn', 'glc', 'wav', 'cpl']: + for comp in ['atm', 'lnd', 'rof', 'ice', 'ocn', 'glc', 'wav', 'cpl', 'iac']: tag = d + '_' + comp if tag in self.data[d]: ET.SubElement(newnode, tag).text = str(self.data[d][tag]) @@ -127,7 +127,7 @@ def set_data(self, xmlnode): # Set Defaults for d in ['ntasks', 'nthrds', 'rootpe']: self.data[d] = {} - for comp in ['atm', 'lnd', 'ice', 'ocn', 'glc', 'rof', 'wav', 'cpl']: + for comp in ['atm', 'lnd', 'ice', 'ocn', 'glc', 'rof', 'wav', 'cpl', 'iac']: self.data['ntasks']['ntasks_' + comp] = self.ISDEFAULT self.data['nthrds']['nthrds_' + comp] = self.ISDEFAULT self.data['rootpe']['rootpe_' + comp] = self.ISDEFAULT @@ -144,7 +144,7 @@ def set_data(self, xmlnode): self.data['pesize'] = xmlnode.get('PECOUNT', default='any') self.data['compset'] = xmlnode.get('CCSM_LCOMPSET', default='any') for d in ['ntasks', 'nthrds', 'rootpe']: - for comp in ['atm', 'lnd', 'ice', 'ocn', 'glc', 'rof', 'wav', 'cpl']: + for comp in ['atm', 'lnd', 'ice', 'ocn', 'glc', 'rof', 'wav', 'cpl', 'iac']: tag = d + '_' + comp node = xmlnode.find(tag.upper()) if node is not None: @@ -169,7 +169,7 @@ def set_data(self, xmlnode): atmtag = d + '_atm' if self.data[d][atmtag] == self.ISDEFAULT: self.data[d][atmtag] = self.DEFAULTS[d] - for comp in ['lnd', 'rof', 'ice', 'ocn', 'glc', 'wav', 'cpl']: + for comp in ['lnd', 'rof', 'ice', 'ocn', 'glc', 'wav', 'cpl', 'iac']: tag = d + '_' + comp if self.data[d][tag] == self.ISDEFAULT: self.data[d][tag] = self.data[d][atmtag] diff --git a/scripts/Tools/xmlconvertors/grid_xml_converter.py b/scripts/Tools/xmlconvertors/grid_xml_converter.py index a4f31944b61f..da26917a4938 100755 --- a/scripts/Tools/xmlconvertors/grid_xml_converter.py +++ b/scripts/Tools/xmlconvertors/grid_xml_converter.py @@ -116,7 +116,7 @@ def set_data(self, xmlnode): self.data['maps'] = {} self.xmlnode = xmlnode for k in ['atm_grid', 'lnd_grid', 'ocn_grid', 'rof_grid', 'glc_grid', - 'wav_grid', 'ice_grid']: + 'wav_grid', 'ice_grid', 'iac_grid' ]: att = xmlnode.get(k) if att is not None: self.data[k] = att.strip() diff --git a/scripts/lib/CIME/SystemTests/system_tests_common.py b/scripts/lib/CIME/SystemTests/system_tests_common.py index ea5f29114b42..ea9a4fe271eb 100644 --- a/scripts/lib/CIME/SystemTests/system_tests_common.py +++ b/scripts/lib/CIME/SystemTests/system_tests_common.py @@ -263,13 +263,20 @@ def _component_compare_copy(self, suffix): comments = copy(self._case, suffix) append_testlog(comments) - def _component_compare_test(self, suffix1, suffix2, success_change=False): + def _component_compare_test(self, suffix1, suffix2, + success_change=False, + ignore_fieldlist_diffs=False): """ Return value is not generally checked, but is provided in case a custom run case needs indirection based on success. - If success_change is True, success requires some files to be different - """ - success, comments = self._do_compare_test(suffix1, suffix2) + If success_change is True, success requires some files to be different. + If ignore_fieldlist_diffs is True, then: If the two cases differ only in their + field lists (i.e., all shared fields are bit-for-bit, but one case has some + diagnostic fields that are missing from the other case), treat the two cases + as identical. + """ + success, comments = self._do_compare_test(suffix1, suffix2, + ignore_fieldlist_diffs=ignore_fieldlist_diffs) if success_change: success = not success @@ -279,12 +286,21 @@ def _component_compare_test(self, suffix1, suffix2, success_change=False): self._test_status.set_status("{}_{}_{}".format(COMPARE_PHASE, suffix1, suffix2), status) return success - def _do_compare_test(self, suffix1, suffix2): + def _do_compare_test(self, suffix1, suffix2, ignore_fieldlist_diffs=False): """ Wraps the call to compare_test to facilitate replacement in unit tests """ - return compare_test(self._case, suffix1, suffix2) + return compare_test(self._case, suffix1, suffix2, + ignore_fieldlist_diffs=ignore_fieldlist_diffs) + + def _st_archive_case_test(self): + result = self._case.test_env_archive() + with self._test_status: + if result: + self._test_status.set_status(STARCHIVE_PHASE, TEST_PASS_STATUS) + else: + self._test_status.set_status(STARCHIVE_PHASE, TEST_FAIL_STATUS) def _st_archive_case_test(self): result = self._case.test_env_archive() diff --git a/scripts/lib/CIME/SystemTests/system_tests_compare_two.py b/scripts/lib/CIME/SystemTests/system_tests_compare_two.py index 80ac99ca2c53..6958cf818240 100644 --- a/scripts/lib/CIME/SystemTests/system_tests_compare_two.py +++ b/scripts/lib/CIME/SystemTests/system_tests_compare_two.py @@ -52,7 +52,8 @@ def __init__(self, run_two_suffix = 'test', run_one_description = '', run_two_description = '', - multisubmit = False): + multisubmit = False, + ignore_fieldlist_diffs = False): """ Initialize a SystemTestsCompareTwo object. Individual test cases that inherit from SystemTestsCompareTwo MUST call this __init__ method. @@ -71,10 +72,16 @@ def __init__(self, when starting the second run. Defaults to ''. multisubmit (bool): Do first and second runs as different submissions. Designed for tests with RESUBMIT=1 + ignore_fieldlist_diffs (bool): If True, then: If the two cases differ only in + their field lists (i.e., all shared fields are bit-for-bit, but one case + has some diagnostic fields that are missing from the other case), treat + the two cases as identical. (This is needed for tests where one case + exercises an option that produces extra diagnostic fields.) """ SystemTestsCommon.__init__(self, case) self._separate_builds = separate_builds + self._ignore_fieldlist_diffs = ignore_fieldlist_diffs # run_one_suffix is just used as the suffix for the netcdf files # produced by the first case; we may eventually remove this, but for now @@ -250,7 +257,9 @@ def run_phase(self, success_change=False): # pylint: disable=arguments-differ # Case1 is the "main" case, and we need to do the comparisons from there self._activate_case1() self._link_to_case2_output() - self._component_compare_test(self._run_one_suffix, self._run_two_suffix, success_change=success_change) + self._component_compare_test(self._run_one_suffix, self._run_two_suffix, + success_change=success_change, + ignore_fieldlist_diffs=self._ignore_fieldlist_diffs) def copy_case1_restarts_to_case2(self): """ diff --git a/scripts/lib/CIME/XML/grids.py b/scripts/lib/CIME/XML/grids.py index 93fd54ca9b62..64402bbeb671 100644 --- a/scripts/lib/CIME/XML/grids.py +++ b/scripts/lib/CIME/XML/grids.py @@ -157,7 +157,7 @@ def _read_config_grids(self, name, compset, atmnlev, lndnlev): # determine component grids and associated required domains and gridmaps # TODO: this should be in XML, not here - prefix = {"atm":"a%", "lnd":"l%", "ocnice":"oi%", "rof":"r%", "wav":"w%", "glc":"g%", "mask":"m%"} + prefix = {"atm":"a%", "lnd":"l%", "ocnice":"oi%", "rof":"r%", "wav":"w%", "glc":"g%", "mask":"m%", "iac":"z%"} lname = "" for component_gridname in self._comp_gridnames: if lname: @@ -204,7 +204,7 @@ def _get_domains(self, component_grids, atmlevregex, lndlevregex, driver): # use component_grids to create grids dictionary # TODO: this should be in XML, not here grids = [("atm", "a%"), ("lnd", "l%"), ("ocn", "o%"), ("mask", "m%"),\ - ("ice", "i%"), ("rof", "r%"), ("glc", "g%"), ("wav", "w%")] + ("ice", "i%"), ("rof", "r%"), ("glc", "g%"), ("wav", "w%"), ("iac", "z%")] domains = {} mask_name = None if 'm%' in component_grids: @@ -281,7 +281,7 @@ def _get_gridmaps(self, component_grids, driver): set all mapping files for config_grids.xml v2 schema """ grids = [("atm_grid","a%"), ("lnd_grid","l%"), ("ocn_grid","o%"), \ - ("rof_grid","r%"), ("glc_grid","g%"), ("wav_grid","w%")] + ("rof_grid","r%"), ("glc_grid","g%"), ("wav_grid","w%"), ("iac_grid","z%")] gridmaps = {} # (1) set all possibly required gridmaps to idmap diff --git a/scripts/lib/CIME/case/case.py b/scripts/lib/CIME/case/case.py index 220a554bb455..ba7b942e4172 100644 --- a/scripts/lib/CIME/case/case.py +++ b/scripts/lib/CIME/case/case.py @@ -544,29 +544,30 @@ def _valid_compset_impl(self, compset_name, comp_classes, comp_hash): ('2000_DATM%NYF_SLND_DICE%SSMI_DOCN%DOM_DROF%NYF_SGLC_SWAV_SESP', ['2000', 'DATM%NYF', 'SLND', 'DICE%SSMI', 'DOCN%DOM', 'DROF%NYF', 'SGLC', 'SWAV', 'SESP']) >>> Case(read_only=False)._valid_compset_impl('2000_DICE%SSMI_DOCN%DOM_DATM%NYF_DROF%NYF', ['CPL', 'ATM', 'LND', 'ICE', 'OCN', 'ROF', 'GLC', 'WAV', 'ESP'], {'datm':1,'satm':1,'dlnd':2,'slnd':2,'dice':3,'sice':3,'docn':4,'socn':4,'drof':5,'srof':5,'sglc':6,'swav':7,'ww3':7,'sesp':8}) ('2000_DATM%NYF_SLND_DICE%SSMI_DOCN%DOM_DROF%NYF_SGLC_SWAV_SESP', ['2000', 'DATM%NYF', 'SLND', 'DICE%SSMI', 'DOCN%DOM', 'DROF%NYF', 'SGLC', 'SWAV', 'SESP']) + >>> Case(read_only=False)._valid_compset_impl('2000_DICE%SSMI_DOCN%DOM_DATM%NYF_DROF%NYF_TEST', ['CPL', 'ATM', 'LND', 'ICE', 'OCN', 'ROF', 'GLC', 'WAV', 'ESP'], {'datm':1,'satm':1,'dlnd':2,'slnd':2,'dice':3,'sice':3,'docn':4,'socn':4,'drof':5,'srof':5,'sglc':6,'swav':7,'ww3':7,'sesp':8}) + ('2000_DATM%NYF_SLND_DICE%SSMI_DOCN%DOM_DROF%NYF_SGLC_SWAV_SESP_TEST', ['2000', 'DATM%NYF', 'SLND', 'DICE%SSMI', 'DOCN%DOM', 'DROF%NYF', 'SGLC', 'SWAV', 'SESP']) >>> Case(read_only=False)._valid_compset_impl('1850_CAM60_CLM50%BGC-CROP_CICE_POP2%ECO%ABIO-DIC_MOSART_CISM2%NOEVOLVE_WW3_BGC%BDRD', ['CPL', 'ATM', 'LND', 'ICE', 'OCN', 'ROF', 'GLC', 'WAV', 'ESP'], {'datm':1,'satm':1, 'cam':1,'dlnd':2,'clm':2,'slnd':2,'cice':3,'dice':3,'sice':3,'pop':4,'docn':4,'socn':4,'mosart':5,'drof':5,'srof':5,'cism':6,'sglc':6,'ww':7,'swav':7,'ww3':7,'sesp':8}) - ('1850_CAM60_CLM50%BGC-CROP_CICE_POP2%ECO%ABIO-DIC_MOSART_CISM2%NOEVOLVE_WW3_SESP_BGC%BDRD', ['1850', 'CAM60', 'CLM50%BGC-CROP', 'CICE', 'POP2%ECO%ABIO-DIC', 'MOSART', 'CISM2%NOEVOLVE', 'WW3', 'SESP', 'BGC%BDRD']) + ('1850_CAM60_CLM50%BGC-CROP_CICE_POP2%ECO%ABIO-DIC_MOSART_CISM2%NOEVOLVE_WW3_SESP_BGC%BDRD', ['1850', 'CAM60', 'CLM50%BGC-CROP', 'CICE', 'POP2%ECO%ABIO-DIC', 'MOSART', 'CISM2%NOEVOLVE', 'WW3', 'SESP']) + >>> Case(read_only=False)._valid_compset_impl('1850_CAM60_CLM50%BGC-CROP_CICE_POP2%ECO%ABIO-DIC_MOSART_CISM2%NOEVOLVE_WW3_BGC%BDRD_TEST', ['CPL', 'ATM', 'LND', 'ICE', 'OCN', 'ROF', 'GLC', 'WAV', 'IAC', 'ESP'], {'datm':1,'satm':1, 'cam':1,'dlnd':2,'clm':2,'slnd':2,'cice':3,'dice':3,'sice':3,'pop':4,'docn':4,'socn':4,'mosart':5,'drof':5,'srof':5,'cism':6,'sglc':6,'ww':7,'swav':7,'ww3':7,'sesp':8}) + ('1850_CAM60_CLM50%BGC-CROP_CICE_POP2%ECO%ABIO-DIC_MOSART_CISM2%NOEVOLVE_WW3_SIAC_SESP_BGC%BDRD_TEST', ['1850', 'CAM60', 'CLM50%BGC-CROP', 'CICE', 'POP2%ECO%ABIO-DIC', 'MOSART', 'CISM2%NOEVOLVE', 'WW3', 'SIAC', 'SESP']) """ # Find the models declared in the compset model_set = [None]*len(comp_classes) components = compset_name.split('_') model_set[0] = components[0] - # Check for BGC - if components[-1][0:3] == 'BGC': - bgc = components[-1] - last_ind = len(components) - 1 - else: - bgc = None - last_ind = len(components) - - for model in components[1:last_ind]: + noncomps = [] + for model in components[1:]: match = Case.__mod_match_re__.match(model.lower()) expect(match is not None, "No model match for {}".format(model)) mod_match = match.group(1) - expect(mod_match in comp_hash, - "Unknown model type, {}".format(model)) - comp_ind = comp_hash[mod_match] - model_set[comp_ind] = model + # Check for noncomponent appends (BGC & TEST) + if mod_match in ('bgc', 'test'): + noncomps.append(model) + else: + expect(mod_match in comp_hash, + "Unknown model type, {}".format(model)) + comp_ind = comp_hash[mod_match] + model_set[comp_ind] = model # Fill in missing components with stubs for comp_ind in range(1, len(model_set)): @@ -577,10 +578,10 @@ def _valid_compset_impl(self, compset_name, comp_classes, comp_hash): model_set[comp_ind] = stub # Return the completed compset - if bgc is not None: - model_set.append(bgc) - compsetname = '_'.join(model_set) + for noncomp in noncomps: + compsetname = compsetname + '_' + noncomp + return compsetname, model_set # RE to match component type name without optional piece (stuff after %). @@ -759,8 +760,7 @@ def _get_component_config_data(self, files, driver=None): logger.info("{} component is {}".format(comp_class, self._component_description[comp_class])) for env_file in self._env_entryid_files: env_file.add_elements_by_group(compobj, attributes=attlist) - - self.clean_up_lookups() + self.clean_up_lookups(allow_undefined=driver=='nuopc') def _setup_mach_pes(self, pecount, multi_driver, ninst, machine_name, mpilib): #-------------------------------------------- diff --git a/scripts/lib/CIME/case/case_submit.py b/scripts/lib/CIME/case/case_submit.py index 180d4f1dfd91..9907f6b7ab7f 100644 --- a/scripts/lib/CIME/case/case_submit.py +++ b/scripts/lib/CIME/case/case_submit.py @@ -41,7 +41,7 @@ def _submit(case, job=None, no_batch=False, prereq=None, allow_fail=False, resub rpointer = "rpointer.drv" expect(os.path.exists(os.path.join(rundir,rpointer)), "CONTINUE_RUN is true but this case does not appear to have restart files staged in {}".format(rundir)) - # Finally we open the rpointer.drv file and check that it's correct + # Finally we open the rpointer file and check that it's correct casename = case.get_value("CASE") with open(os.path.join(rundir,rpointer), "r") as fd: ncfile = fd.readline().strip() diff --git a/scripts/lib/CIME/hist_utils.py b/scripts/lib/CIME/hist_utils.py index fdc3c280da56..235555d4ccc8 100644 --- a/scripts/lib/CIME/hist_utils.py +++ b/scripts/lib/CIME/hist_utils.py @@ -237,7 +237,8 @@ def _hists_match(model, hists1, hists2, suffix1="", suffix2=""): return one_not_two, two_not_one, match_ups -def _compare_hists(case, from_dir1, from_dir2, suffix1="", suffix2="", outfile_suffix=""): +def _compare_hists(case, from_dir1, from_dir2, suffix1="", suffix2="", outfile_suffix="", + ignore_fieldlist_diffs=False): if from_dir1 == from_dir2: expect(suffix1 != suffix2, "Comparing files to themselves?") @@ -278,7 +279,8 @@ def _compare_hists(case, from_dir1, from_dir2, suffix1="", suffix2="", outfile_s for hist1, hist2 in match_ups: success, cprnc_log_file, cprnc_comment = cprnc(model, hist1, hist2, case, from_dir1, multiinst_driver_compare=multiinst_driver_compare, - outfile_suffix=outfile_suffix) + outfile_suffix=outfile_suffix, + ignore_fieldlist_diffs=ignore_fieldlist_diffs) if success: comments += " {} matched {}\n".format(hist1, hist2) else: @@ -304,21 +306,27 @@ def _compare_hists(case, from_dir1, from_dir2, suffix1="", suffix2="", outfile_s return all_success, comments -def compare_test(case, suffix1, suffix2): +def compare_test(case, suffix1, suffix2, ignore_fieldlist_diffs=False): """ Compares two sets of component history files in the testcase directory case - The case containing the hist files to compare suffix1 - The suffix that identifies the first batch of hist files suffix1 - The suffix that identifies the second batch of hist files + ignore_fieldlist_diffs (bool): If True, then: If the two cases differ only in their + field lists (i.e., all shared fields are bit-for-bit, but one case has some + diagnostic fields that are missing from the other case), treat the two cases as + identical. returns (SUCCESS, comments) """ rundir = case.get_value("RUNDIR") - return _compare_hists(case, rundir, rundir, suffix1, suffix2) + return _compare_hists(case, rundir, rundir, suffix1, suffix2, + ignore_fieldlist_diffs=ignore_fieldlist_diffs) -def cprnc(model, file1, file2, case, rundir, multiinst_driver_compare=False, outfile_suffix=""): +def cprnc(model, file1, file2, case, rundir, multiinst_driver_compare=False, outfile_suffix="", + ignore_fieldlist_diffs=False): """ Run cprnc to compare two individual nc files @@ -329,6 +337,10 @@ def cprnc(model, file1, file2, case, rundir, multiinst_driver_compare=False, out outfile_suffix - if non-blank, then the output file name ends with this suffix (with a '.' added before the given suffix). Use None to avoid permissions issues in the case dir. + ignore_fieldlist_diffs (bool): If True, then: If the two cases differ only in their + field lists (i.e., all shared fields are bit-for-bit, but one case has some + diagnostic fields that are missing from the other case), treat the two cases as + identical. returns (True if the files matched, log_name, comment) where 'comment' is either an empty string or one of the module-level constants @@ -376,8 +388,11 @@ def cprnc(model, file1, file2, case, rundir, multiinst_driver_compare=False, out elif "the two files seem to be DIFFERENT" in out: files_match = False elif "the two files DIFFER only in their field lists" in out: - files_match = False - comment = CPRNC_FIELDLISTS_DIFFER + if ignore_fieldlist_diffs: + files_match = True + else: + files_match = False + comment = CPRNC_FIELDLISTS_DIFFER else: expect(False, "Did not find an expected summary string in cprnc output") else: diff --git a/scripts/lib/CIME/tests/SystemTests/test_system_tests_compare_two.py b/scripts/lib/CIME/tests/SystemTests/test_system_tests_compare_two.py index 694e586e0d99..d9757bb37061 100644 --- a/scripts/lib/CIME/tests/SystemTests/test_system_tests_compare_two.py +++ b/scripts/lib/CIME/tests/SystemTests/test_system_tests_compare_two.py @@ -179,7 +179,7 @@ def run_indv(self, suffix="base", st_archive=False): if caseroot not in self.run_pass_caseroot: raise RuntimeError('caseroot not in run_pass_caseroot') - def _do_compare_test(self, suffix1, suffix2): + def _do_compare_test(self, suffix1, suffix2, ignore_fieldlist_diffs=False): """ This fake implementation allows controlling whether compare_test passes or fails diff --git a/src/components/data_comps/datm/nuopc/atm_comp_nuopc.F90 b/src/components/data_comps/datm/nuopc/atm_comp_nuopc.F90 index 741e79da16cc..9c3f2d03e1c2 100644 --- a/src/components/data_comps/datm/nuopc/atm_comp_nuopc.F90 +++ b/src/components/data_comps/datm/nuopc/atm_comp_nuopc.F90 @@ -27,16 +27,14 @@ module atm_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - use shr_nuopc_grid_mod , only : shr_nuopc_grid_ArrayToState - use shr_nuopc_grid_mod , only : shr_nuopc_grid_StateToArray use shr_strdata_mod , only : shr_strdata_type use shr_const_mod , only : SHR_CONST_SPVAL - use dshr_nuopc_mod , only : fld_list_type, fldsMax, fld_list_realize + use dshr_nuopc_mod , only : fld_list_type, fldsMax, dshr_realize use dshr_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, ModelSetMetaData use datm_shr_mod , only : datm_shr_read_namelists use datm_shr_mod , only : iradsw, datm_shr_getNextRadCDay - use datm_comp_mod , only : datm_comp_init, datm_comp_run, datm_comp_advertise - use mct_mod , only : mct_Avect, mct_Avect_info + use datm_comp_mod , only : datm_comp_advertise, datm_comp_init, datm_comp_run + use datm_comp_mod , only : datm_comp_import, datm_comp_export implicit none private ! except @@ -57,9 +55,6 @@ module atm_comp_nuopc type (fld_list_type) :: fldsToAtm(fldsMax) type (fld_list_type) :: fldsFrAtm(fldsMax) - type(shr_strdata_type) :: SDATM - type(mct_aVect) :: x2a - type(mct_aVect) :: a2x integer :: compid ! mct comp id integer :: mpicom ! mpi communicator integer :: my_task ! my task in mpi communicator mpicom @@ -71,8 +66,6 @@ module atm_comp_nuopc character(len=256) :: case_name ! case name character(len=80) :: calendar ! calendar name logical :: atm_prognostic ! data is sent back to datm - character(len=CXX) :: flds_a2x = '' - character(len=CXX) :: flds_x2a = '' logical :: use_esmf_metadata = .false. character(*),parameter :: modName = "(atm_comp_nuopc)" integer, parameter :: debug_import = 0 ! if > 0 will diagnose import fields @@ -89,12 +82,11 @@ subroutine SetServices(gcomp, rc) integer, intent(out) :: rc ! local variables - integer :: dbrc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) @@ -129,7 +121,7 @@ subroutine SetServices(gcomp, rc) specRoutine=ModelFinalize, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine SetServices @@ -140,6 +132,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) use shr_nuopc_utils_mod, only : shr_nuopc_set_component_logging use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -153,19 +146,17 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: ierr ! error code integer :: shrlogunit ! original log unit integer :: shrloglev ! original log level - logical :: isPresent integer :: localPet logical :: flds_co2a ! use case logical :: flds_co2b ! use case logical :: flds_co2c ! use case logical :: flds_wiso ! use case - integer :: dbrc character(len=CL) :: fileName ! generic file name character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! generate local mpi comm @@ -198,8 +189,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- filename = "datm_in"//trim(inst_suffix) - call datm_shr_read_namelists(filename, mpicom, my_task, master_task, & - logunit, SDATM, atm_prognostic) + call datm_shr_read_namelists(filename, mpicom, my_task, master_task, logunit, atm_prognostic) !-------------------------------- ! determine necessary toggles for below @@ -208,35 +198,33 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2a - call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO) call NUOPC_CompAttributeGet(gcomp, name='flds_co2b', value=cvalue, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2b - call ESMF_LogWrite('flds_co2b = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite('flds_co2b = '// trim(cvalue), ESMF_LOGMSG_INFO) call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2c - call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO) call NUOPC_CompAttributeGet(gcomp, name='flds_wiso', value=cvalue, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_wiso - call ESMF_LogWrite('flds_wiso = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite('flds_wiso = '// trim(cvalue), ESMF_LOGMSG_INFO) !-------------------------------- ! advertise import and export fields !-------------------------------- call datm_comp_advertise(importState, exportState, & - atm_prognostic, & - flds_wiso, flds_co2a, flds_co2b, flds_co2c, & - fldsFrAtm_num, fldsFrAtm, fldsToAtm_num, fldsToAtm, & - flds_a2x, flds_x2a, rc) + atm_prognostic, flds_wiso, flds_co2a, flds_co2b, flds_co2c, & + fldsFrAtm_num, fldsFrAtm, fldsToAtm_num, fldsToAtm, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! Reset shr logging to original values @@ -250,6 +238,8 @@ end subroutine InitializeAdvertise !=============================================================================== subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -280,7 +270,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) real(R8) :: orbMvelpp ! orb moving vernal eq (radians) real(R8) :: orbLambm0 ! orb mean long of perhelion (radians) real(R8) :: orbObliqr ! orb obliquity (radians) - integer :: dbrc + integer :: nxg, nyg character(len=*), parameter :: subname=trim(modName)//':(InitializeRealize) ' !------------------------------------------------------------------------------- @@ -288,7 +278,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! from the config attributes of the gridded component rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! Reset shr logging to my log file @@ -357,7 +347,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then calendar = shr_cal_gregorian else - call ESMF_LogWrite(subname//" ERROR bad ESMF calendar name "//trim(calendar), ESMF_LOGMSG_ERROR, rc=dbrc) + call ESMF_LogWrite(subname//" ERROR bad ESMF calendar name "//trim(calendar), ESMF_LOGMSG_ERROR) rc = ESMF_Failure return end if @@ -389,13 +379,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Initialize model !---------------------------------------------------------------------------- - call datm_comp_init(x2a, a2x, & - SDATM, mpicom, compid, my_task, master_task, & + call datm_comp_init(mpicom, compid, my_task, master_task, & inst_suffix, inst_name, logunit, read_restart, & scmMode, scmlat, scmlon, & orbEccen, orbMvelpp, orbLambm0, orbObliqr, & calendar, modeldt, current_ymd, current_tod, current_mon, & - atm_prognostic, EMesh) + atm_prognostic, EMesh, nxg, nyg) !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -403,7 +392,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! by replacing the advertised fields with the newly created fields of the same name. !-------------------------------- - call fld_list_realize( & + call dshr_realize( & state=ExportState, & fldList=fldsFrAtm, & numflds=fldsFrAtm_num, & @@ -413,7 +402,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) mesh=Emesh, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call fld_list_realize( & + call dshr_realize( & state=importState, & fldList=fldsToAtm, & numflds=fldsToAtm_num, & @@ -425,21 +414,20 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- ! Pack export state - ! Copy from a2x to exportState ! Set the coupling scalars !-------------------------------- - call shr_nuopc_grid_ArrayToState(a2x%rattr, flds_a2x, exportState, grid_option='mesh', rc=rc) + call datm_comp_export(exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDATM%nxg),flds_scalar_index_nx, exportState, & + call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDATM%nyg),flds_scalar_index_ny, exportState, & + call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - + call shr_nuopc_methods_State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -449,7 +437,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- if (debug_export > 0) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) + call shr_nuopc_methods_State_diagnose(exportState, subname//':ES',rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -465,15 +453,17 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine InitializeRealize !=============================================================================== subroutine ModelAdvance(gcomp, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_log_clock_advance, shr_nuopc_memcheck use perf_mod, only : t_startf, t_stopf + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -501,12 +491,11 @@ subroutine ModelAdvance(gcomp, rc) real(R8) :: orbLambm0 ! orb mean long of perhelion (radians) real(R8) :: orbObliqr ! orb obliquity (radians) character(len=256) :: cvalue - integer :: dbrc character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- call t_startf(subname) rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) call shr_nuopc_memcheck(subname, 5, my_task==master_task) !-------------------------------- @@ -535,7 +524,7 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- if (atm_prognostic) then - call shr_nuopc_grid_StateToArray(importState, x2a%rattr, flds_x2a, grid_option='mesh', rc=rc) + call datm_comp_import(importState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -543,6 +532,7 @@ subroutine ModelAdvance(gcomp, rc) ! Run model !-------------------------------- + call t_startf('datm_get_attributes') ! Get orbital parameters (these can be changed by the mediator) ! TODO: need to put in capability for these to be modified for variable orbitals call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, rc=rc) @@ -557,9 +547,12 @@ subroutine ModelAdvance(gcomp, rc) call NUOPC_CompAttributeGet(gcomp, name='orb_mvelpp', value=cvalue, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) orbMvelpp + call t_stopf('datm_get_attributes') ! Determine if need to write restarts + call t_startf('datm_get_clockinfo') + call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -587,14 +580,17 @@ subroutine ModelAdvance(gcomp, rc) call ESMF_TimeIntervalGet( timeStep, s=modeldt, rc=rc ) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('datm_get_clockinfo') + ! Advance the model - call datm_comp_run( x2a, a2x, & - SDATM, mpicom, compid, my_task, master_task, & + call t_startf('datm_run') + call datm_comp_run( mpicom, compid, my_task, master_task, & inst_suffix, logunit, & orbEccen, orbMvelpp, orbLambm0, orbObliqr, & write_restart, nextYMD, nextTOD, mon, modeldt, calendar, & atm_prognostic, case_name) + call t_stopf('datm_run') ! Use nextYMD and nextTOD here since since the component - clock is advance at the END of the time interval nextsw_cday = datm_shr_getNextRadCDay( nextYMD, nextTOD, stepno, modeldt, iradsw, calendar ) @@ -603,12 +599,16 @@ subroutine ModelAdvance(gcomp, rc) ! Pack export state !-------------------------------- - call shr_nuopc_grid_ArrayToState(a2x%rattr, flds_a2x, exportState, grid_option='mesh', rc=rc) + call t_startf('datm_export') + call datm_comp_export(exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('datm_export') + call t_startf('datm_export_setscalar') call shr_nuopc_methods_State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('datm_export_setscalar') !-------------------------------- ! diagnostics @@ -619,7 +619,7 @@ subroutine ModelAdvance(gcomp, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if if(my_task == master_task) then - call shr_nuopc_log_clock_advance(clock, 'ATM', logunit) + call shr_nuopc_log_clock_advance(clock, 'DATM', logunit) endif !---------------------------------------------------------------------------- ! Reset shr logging to original values @@ -628,7 +628,7 @@ subroutine ModelAdvance(gcomp, rc) call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) call t_stopf(subname) end subroutine ModelAdvance @@ -640,20 +640,19 @@ subroutine ModelFinalize(gcomp, rc) integer, intent(out) :: rc ! local variables - integer :: dbrc character(*), parameter :: F00 = "('(datm_comp_final) ',8a)" character(*), parameter :: F91 = "('(datm_comp_final) ',73('-'))" character(len=*),parameter :: subname=trim(modName)//':(ModelFinalize) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) if (my_task == master_task) then write(logunit,F91) write(logunit,F00) 'datm : end of main integration loop' write(logunit,F91) end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine ModelFinalize diff --git a/src/components/data_comps/datm/nuopc/datm_comp_mod.F90 b/src/components/data_comps/datm/nuopc/datm_comp_mod.F90 index dff6722e109d..2450690262fd 100644 --- a/src/components/data_comps/datm/nuopc/datm_comp_mod.F90 +++ b/src/components/data_comps/datm/nuopc/datm_comp_mod.F90 @@ -1,6 +1,7 @@ #ifdef AIX @PROCESS ALIAS_SIZE(805306368) #endif + module datm_comp_mod ! !USES: @@ -35,8 +36,7 @@ module datm_comp_mod use shr_dmodel_mod , only : shr_dmodel_translate_list, shr_dmodel_translateAV_list use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use dshr_nuopc_mod , only : fld_list_type - use dshr_nuopc_mod , only : dshr_fld_add + use dshr_nuopc_mod , only : fld_list_type, dshr_fld_add, dshr_export, dshr_import use datm_shr_mod , only : datm_shr_esat, datm_shr_CORE2getFactors use datm_shr_mod , only : datamode ! namelist input use datm_shr_mod , only : wiso_datm ! namelist input @@ -46,6 +46,7 @@ module datm_comp_mod use datm_shr_mod , only : iradsw ! namelist input use datm_shr_mod , only : nullstr use datm_shr_mod , only : presaero + use datm_shr_mod , only : SDATM ! !PUBLIC TYPES: @@ -59,11 +60,18 @@ module datm_comp_mod public :: datm_comp_advertise public :: datm_comp_init public :: datm_comp_run + public :: datm_comp_import + public :: datm_comp_export !-------------------------------------------------------------------------- ! Private data !-------------------------------------------------------------------------- + type(mct_aVect) :: x2a + type(mct_aVect) :: a2x + character(CXX) :: flds_a2x = '' + character(CXX) :: flds_x2a = '' + integer :: debug_import = 0 ! debug level (if > 0 will print all import fields) integer :: debug_export = 0 ! debug level (if > 0 will print all export fields) @@ -76,15 +84,19 @@ module datm_comp_mod integer :: krc,krl,ksc,ksl,kswndr,kswndf,kswvdr,kswvdf,kswnet integer :: kanidr,kanidf,kavsdr,kavsdf integer :: kshum_16O, kshum_18O, kshum_HDO - integer :: krc_18O, krc_HDO - integer :: krl_18O, krl_HDO - integer :: ksc_18O, ksc_HDO - integer :: ksl_18O, ksl_HDO + integer :: krc_16O, krc_18O, krc_HDO + integer :: krl_16O, krl_18O, krl_HDO + integer :: ksc_16O, ksc_18O, ksc_HDO + integer :: ksl_16O, ksl_18O, ksl_HDO integer :: stbot,swind,sz,spbot,sshum,stdew,srh,slwdn,sswdn,sswdndf,sswdndr integer :: sprecc,sprecl,sprecn,sco2p,sco2d,sswup,sprec,starcf integer :: srh_16O, srh_18O, srh_HDO, sprecn_16O, sprecn_18O, sprecn_HDO integer :: sprecsf integer :: sprec_af,su_af,sv_af,stbot_af,sshum_af,spbot_af,slwdn_af,sswdn_af + integer :: kbcphidry, kbcphodry, kbcphiwet + integer :: kocphidry, kocphodry, kocphiwet + integer :: kdstdry1, kdstdry2, kdstdry3, kdstdry4 + integer :: kdstwet1, kdstwet2, kdstwet3, kdstwet4 type(mct_avect) :: avstrm ! av of data from stream character(len=CS), pointer :: avifld(:) ! character array for field names coming from streams @@ -98,8 +110,6 @@ module datm_comp_mod character(len=CL), pointer :: olist_st(:) ! output character array for translation (stifld->strmofld) integer , pointer :: count_st(:) ! number of fields in translation (stifld->strmofld) character(len=CXX) :: flds_strm = '' ! colon deliminated string of field names - character(len=CXX) :: flds_a2x_mod - character(len=CXX) :: flds_x2a_mod real(R8), pointer :: xc(:), yc(:) ! arrays of model latitudes and longitudes real(R8), pointer :: windFactor(:) @@ -122,6 +132,8 @@ module datm_comp_mod data dTarc / 0.49_R8, 0.06_R8,-0.73_R8, -0.89_R8,-0.77_R8,-1.02_R8, & -1.99_R8,-0.91_R8, 1.72_R8, 2.30_R8, 1.81_R8, 1.06_R8/ + logical :: flds_co2a, flds_co2b, flds_co2c, flds_wiso + character(len=*),parameter :: rpfile = 'rpointer.atm' character(*),parameter :: u_FILE_u = & __FILE__ @@ -131,10 +143,8 @@ module datm_comp_mod !=============================================================================== subroutine datm_comp_advertise(importState, exportState, & - atm_prognostic, & - flds_wiso, flds_co2a, flds_co2b, flds_co2c, & - fldsFrAtm_num, fldsFrAtm, fldsToAtm_num, fldsToAtm, & - flds_a2x, flds_x2a, rc) + atm_prognostic, flds_wiso_in, flds_co2a_in, flds_co2b_in, flds_co2c_in, & + fldsFrAtm_num, fldsFrAtm, fldsToAtm_num, fldsToAtm, rc) ! 1. determine export and import fields to advertise to mediator ! 2. determine translation of fields from streams to export/import fields @@ -144,16 +154,14 @@ subroutine datm_comp_advertise(importState, exportState, & type(ESMF_State) :: importState type(ESMF_State) :: exportState logical , intent(in) :: atm_prognostic - logical , intent(in) :: flds_wiso ! use case - logical , intent(in) :: flds_co2a ! use case - logical , intent(in) :: flds_co2b ! use case - logical , intent(in) :: flds_co2c ! use case + logical , intent(in) :: flds_wiso_in ! use case + logical , intent(in) :: flds_co2a_in ! use case + logical , intent(in) :: flds_co2b_in ! use case + logical , intent(in) :: flds_co2c_in ! use case integer , intent(out) :: fldsFrAtm_num type (fld_list_type) , intent(out) :: fldsFrAtm(:) integer , intent(out) :: fldsToAtm_num type (fld_list_type) , intent(out) :: fldsToAtm(:) - character(len=*) , intent(out) :: flds_a2x - character(len=*) , intent(out) :: flds_x2a integer , intent(out) :: rc ! local variables @@ -162,6 +170,11 @@ subroutine datm_comp_advertise(importState, exportState, & rc = ESMF_SUCCESS + flds_wiso = flds_wiso_in + flds_co2a = flds_co2a_in + flds_co2b = flds_co2b_in + flds_co2c = flds_co2c_in + !------------------- ! export fields !------------------- @@ -196,28 +209,22 @@ subroutine datm_comp_advertise(importState, exportState, & call dshr_fld_add(data_fld="rainc", data_fld_array=avifld, model_fld="Faxa_rainc", model_fld_array=avofld, & model_fld_concat=flds_a2x, model_fld_index=krc, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - call dshr_fld_add(data_fld="rainl", data_fld_array=avifld, model_fld="Faxa_rainl", model_fld_array=avofld, & model_fld_concat=flds_a2x, model_fld_index=krl, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) call dshr_fld_add(data_fld="snowc", data_fld_array=avifld, model_fld="Faxa_snowc", model_fld_array=avofld, & model_fld_concat=flds_a2x, model_fld_index=ksc, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - call dshr_fld_add(data_fld="snowl", data_fld_array=avifld, model_fld="Faxa_snowl", model_fld_array=avofld, & model_fld_concat=flds_a2x, model_fld_index=ksl, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) call dshr_fld_add(data_fld="swndr", data_fld_array=avifld, model_fld="Faxa_swndr", model_fld_array=avofld, & model_fld_concat=flds_a2x, model_fld_index=kswndr, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - call dshr_fld_add(data_fld="swvdr", data_fld_array=avifld, model_fld="Faxa_swvdr", model_fld_array=avofld, & model_fld_concat=flds_a2x, model_fld_index=kswvdr, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - call dshr_fld_add(data_fld="swndf", data_fld_array=avifld, model_fld="Faxa_swndf", model_fld_array=avofld, & model_fld_concat=flds_a2x, model_fld_index=kswndf, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - call dshr_fld_add(data_fld="swvdf", data_fld_array=avifld, model_fld="Faxa_swvdf", model_fld_array=avofld, & model_fld_concat=flds_a2x, model_fld_index=kswvdf, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - call dshr_fld_add(data_fld="swnet", data_fld_array=avifld, model_fld="Faxa_swnet", model_fld_array=avofld, & model_fld_concat=flds_a2x, model_fld_index=kswnet, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) @@ -232,98 +239,114 @@ subroutine datm_comp_advertise(importState, exportState, & call dshr_fld_add(data_fld="shum", data_fld_array=avifld, model_fld="Sa_shum", model_fld_array=avofld, & model_fld_concat=flds_a2x, model_fld_index=kshum , fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - call dshr_fld_add(data_fld="lwdn", data_fld_array=avifld, model_fld="Faxa_lwdn", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=klwdn , fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) + call dshr_fld_add(data_fld="lwdn", data_fld_array=avifld, & + model_fld="Faxa_lwdn", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=klwdn, & + fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) if (flds_co2a .or. flds_co2b .or. flds_co2c) then - call dshr_fld_add(data_fld="co2prog", data_fld_array=avifld, model_fld="Sa_co2prog", model_fld_array=avofld, & - model_fld_concat=flds_x2a, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) + call dshr_fld_add(data_fld="co2prog", data_fld_array=avifld, & + model_fld="Sa_co2prog", model_fld_array=avofld, model_fld_concat=flds_x2a, & + fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - call dshr_fld_add(data_fld="co2diag", data_fld_array=avifld, model_fld="Sa_co2diag", model_fld_array=avofld, & - model_fld_concat=flds_x2a, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) + call dshr_fld_add(data_fld="co2diag", data_fld_array=avifld, & + model_fld="Sa_co2diag", model_fld_array=avofld, model_fld_concat=flds_x2a, & + fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) end if if (presaero) then - call dshr_fld_add(data_fld="bcphidry", data_fld_array=avifld, model_fld="Faxa_bcphidry", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="bcphodry", data_fld_array=avifld, model_fld="Faxa_bcphodry", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="bcphiwet", data_fld_array=avifld, model_fld="Faxa_bcphiwet", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="ocphidry", data_fld_array=avifld, model_fld="Faxa_ocphidry", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="ocphodry", data_fld_array=avifld, model_fld="Faxa_ocphodry", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="ocphiwet", data_fld_array=avifld, model_fld="Faxa_ocphiwet", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="dstwet1", data_fld_array=avifld, model_fld="Faxa_dstwet1", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="dstwet2", data_fld_array=avifld, model_fld="Faxa_dstwet2", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="dstwet3", data_fld_array=avifld, model_fld="Faxa_dstwet3", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="dstwet4", data_fld_array=avifld, model_fld="Faxa_dstwet4", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="dstdry1", data_fld_array=avifld, model_fld="Faxa_dstdry1", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="dstdry2", data_fld_array=avifld, model_fld="Faxa_dstdry2", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) + call dshr_fld_add(data_fld="bcphidry", data_fld_array=avifld, & + model_fld="Faxa_bcphidry", model_fld_array=avofld, model_fld_index=kbcphidry, model_fld_concat=flds_a2x) + call dshr_fld_add(data_fld="bcphodry", data_fld_array=avifld, & + model_fld="Faxa_bcphodry", model_fld_array=avofld, model_fld_index=kbcphodry, model_fld_concat=flds_a2x) + call dshr_fld_add(data_fld="bcphiwet", data_fld_array=avifld, & + model_fld="Faxa_bcphiwet", model_fld_array=avofld, model_fld_index=kbcphiwet, model_fld_concat=flds_a2x) + + call dshr_fld_add(med_fld='Faxa_bcph', fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm, & + ungridded_lbound=1, ungridded_ubound=3) + + call dshr_fld_add(data_fld="ocphidry", data_fld_array=avifld, & + model_fld="Faxa_ocphidry", model_fld_array=avofld, model_fld_index=kocphidry, model_fld_concat=flds_a2x) + call dshr_fld_add(data_fld="ocphodry", data_fld_array=avifld, & + model_fld="Faxa_ocphodry", model_fld_array=avofld, model_fld_index=kocphodry, model_fld_concat=flds_a2x) + call dshr_fld_add(data_fld="ocphiwet", data_fld_array=avifld, & + model_fld="Faxa_ocphiwet", model_fld_array=avofld, model_fld_index=kocphiwet, model_fld_concat=flds_a2x) + + call dshr_fld_add(med_fld='Faxa_ocph', fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm, & + ungridded_lbound=1, ungridded_ubound=3) + + call dshr_fld_add(data_fld="dstwet1", data_fld_array=avifld, & + model_fld="Faxa_dstwet1", model_fld_array=avofld, model_fld_index=kdstwet1, model_fld_concat=flds_a2x) + call dshr_fld_add(data_fld="dstwet2", data_fld_array=avifld, & + model_fld="Faxa_dstwet2", model_fld_array=avofld, model_fld_index=kdstwet2, model_fld_concat=flds_a2x) + call dshr_fld_add(data_fld="dstwet3", data_fld_array=avifld, & + model_fld="Faxa_dstwet3", model_fld_array=avofld, model_fld_index=kdstwet3, model_fld_concat=flds_a2x) + call dshr_fld_add(data_fld="dstwet4", data_fld_array=avifld, & + model_fld="Faxa_dstwet4", model_fld_array=avofld, model_fld_index=kdstwet4, model_fld_concat=flds_a2x) + + call dshr_fld_add(med_fld='Faxa_dstwet', fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm, & + ungridded_lbound=1, ungridded_ubound=4) + + call dshr_fld_add(data_fld="dstdry1", data_fld_array=avifld, & + model_fld="Faxa_dstdry1", model_fld_array=avofld, model_fld_index=kdstdry1, model_fld_concat=flds_a2x) + call dshr_fld_add(data_fld="dstdry2", data_fld_array=avifld, & + model_fld="Faxa_dstdry2", model_fld_array=avofld, model_fld_index=kdstdry2, model_fld_concat=flds_a2x) + call dshr_fld_add(data_fld="dstdry3", data_fld_array=avifld, & + model_fld="Faxa_dstdry3", model_fld_array=avofld, model_fld_index=kdstdry3, model_fld_concat=flds_a2x) + call dshr_fld_add(data_fld="dstdry4", data_fld_array=avifld, & + model_fld="Faxa_dstdry4", model_fld_array=avofld, model_fld_index=kdstdry4, model_fld_concat=flds_a2x) + + call dshr_fld_add(med_fld='Faxa_dstdry', fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm, & + ungridded_lbound=1, ungridded_ubound=4) - call dshr_fld_add(data_fld="dstdry3", data_fld_array=avifld, model_fld="Faxa_dstdry3", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="dstdry4", data_fld_array=avifld, model_fld="Faxa_dstdry4", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) end if - ! isotopic forcing - + ! isopic forcing if (flds_wiso) then - - call dshr_fld_add(data_fld="rainc_18O", data_fld_array=avifld, model_fld="Faxa_rainc_18O", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=krc_18O, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="rainc_HDO", data_fld_array=avifld, model_fld="Faxa_rainc_HDO", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=krc_HDO, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="rainl_18O", data_fld_array=avifld, model_fld="Faxa_rainl_18O", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=krl_18O, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="rainl_HDO", data_fld_array=avifld, model_fld="Faxa_rainl_HDO", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=krl_HDO, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="snowc_18O", data_fld_array=avifld, model_fld="Faxa_snowc_18O", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=ksc_18O, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="snowc_HDO", data_fld_array=avifld, model_fld="Faxa_snowc_HDO", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=ksc_HDO, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="snowl_18O", data_fld_array=avifld, model_fld="Faxa_snowl_18O", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=ksl_18O, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="snowl_HDO", data_fld_array=avifld, model_fld="Faxa_snowl_HDO", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=ksl_HDO, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="shum_16O", data_fld_array=avifld, model_fld="Sa_shum_16O", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=kshum_16O, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="shum_18O", data_fld_array=avifld, model_fld="Sa_shum_18O", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=kshum_18O, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="shum_HDO", data_fld_array=avifld, model_fld="Sa_shum_HDO", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=kshum_HDO, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) + call dshr_fld_add(data_fld="rainc_16O", data_fld_array=avifld,& + model_fld="Faxa_rainc_18O", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=krc_16O) + call dshr_fld_add(data_fld="rainc_18O", data_fld_array=avifld,& + model_fld="Faxa_rainc_18O", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=krc_18O) + call dshr_fld_add(data_fld="rainc_HDO", data_fld_array=avifld, & + model_fld="Faxa_rainc_HDO", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=krc_HDO) + call dshr_fld_add(med_fld='Faxa_rainc_wiso', fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm, & + ungridded_lbound=1, ungridded_ubound=3) + + call dshr_fld_add(data_fld="rainl_16O", data_fld_array=avifld, & + model_fld="Faxa_rainl_16O", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=krl_16O) + call dshr_fld_add(data_fld="rainl_18O", data_fld_array=avifld, & + model_fld="Faxa_rainl_18O", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=krl_18O) + call dshr_fld_add(data_fld="rainl_HDO", data_fld_array=avifld, & + model_fld="Faxa_rainl_HDO", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=krl_HDO) + call dshr_fld_add(med_fld='Faxa_rainl_wiso', fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm, & + ungridded_lbound=1, ungridded_ubound=3) + + call dshr_fld_add(data_fld="snowc_16O", data_fld_array=avifld, & + model_fld="Faxa_snowc_16O", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=ksc_18O) + call dshr_fld_add(data_fld="snowc_18O", data_fld_array=avifld, & + model_fld="Faxa_snowc_18O", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=ksc_18O) + call dshr_fld_add(data_fld="snowc_HDO", data_fld_array=avifld, & + model_fld="Faxa_snowc_HDO", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=ksc_HDO) + call dshr_fld_add(med_fld='Faxa_snowc_wiso', fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm, & + ungridded_lbound=1, ungridded_ubound=3) + + call dshr_fld_add(data_fld="snowl_16O", data_fld_array=avifld, & + model_fld="Faxa_snowl_16O", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=ksl_18O) + call dshr_fld_add(data_fld="snowl_18O", data_fld_array=avifld, & + model_fld="Faxa_snowl_18O", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=ksl_18O) + call dshr_fld_add(data_fld="snowl_HDO", data_fld_array=avifld, & + model_fld="Faxa_snowl_HDO", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=ksl_HDO) + call dshr_fld_add(med_fld='Faxa_snowl_wiso', fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm, & + ungridded_lbound=1, ungridded_ubound=3) + + call dshr_fld_add(data_fld="shum_16O", data_fld_array=avifld, & + model_fld="Sa_shum_16O", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=kshum_16O) + call dshr_fld_add(data_fld="shum_18O", data_fld_array=avifld, & + model_fld="Sa_shum_18O", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=kshum_18O) + call dshr_fld_add(data_fld="shum_HDO", data_fld_array=avifld, & + model_fld="Sa_shum_HDO", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=kshum_HDO) + call dshr_fld_add(med_fld='Faxa_shum_wiso', fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm, & + ungridded_lbound=1, ungridded_ubound=3) end if !------------------- @@ -380,13 +403,6 @@ subroutine datm_comp_advertise(importState, exportState, & end do end if - !------------------- - ! Save flds_x2a and flds_a2x as module variables for use in debugging - !------------------- - - flds_x2a_mod = trim(flds_x2a) - flds_a2x_mod = trim(flds_a2x) - !------------------- ! module character arrays stifld and stofld !------------------- @@ -443,22 +459,18 @@ end subroutine datm_comp_advertise !=============================================================================== - subroutine datm_comp_init(x2a, a2x, & - SDATM, mpicom, compid, my_task, master_task, & + subroutine datm_comp_init(mpicom, compid, my_task, master_task, & inst_suffix, inst_name, logunit, read_restart, & scmMode, scmlat, scmlon, & orbEccen, orbMvelpp, orbLambm0, orbObliqr, & calendar, modeldt, current_ymd, current_tod, current_mon, & - atm_prognostic, mesh) + atm_prognostic, mesh, nxg, nyg) use dshr_nuopc_mod, only : dshr_fld_add ! !DESCRIPTION: initialize data atm model ! !INPUT/OUTPUT PARAMETERS: - type(mct_aVect) , intent(inout) :: x2a - type(mct_aVect) , intent(inout) :: a2x - type(shr_strdata_type) , intent(inout) :: SDATM ! model shr_strdata instance (output) integer , intent(in) :: mpicom ! mpi communicator integer , intent(in) :: compid ! mct comp id integer , intent(in) :: my_task ! my task in mpi communicator mpicom @@ -481,6 +493,7 @@ subroutine datm_comp_init(x2a, a2x, & integer , intent(in) :: current_mon ! model month logical , intent(in) :: atm_prognostic ! if true, need x2a data type(ESMF_Mesh) , intent(inout) :: mesh + integer , intent(out) :: nxg, nyg !--- local variables --- integer :: n,k ! generic counters @@ -648,9 +661,9 @@ subroutine datm_comp_init(x2a, a2x, & call t_startf('datm_initmctavs') if (my_task == master_task) write(logunit,F00) 'allocate AVs' - call mct_aVect_init(a2x, rList=flds_a2x_mod, lsize=lsize) + call mct_aVect_init(a2x, rList=flds_a2x, lsize=lsize) call mct_aVect_zero(a2x) - call mct_aVect_init(x2a, rList=flds_x2a_mod, lsize=lsize) + call mct_aVect_init(x2a, rList=flds_x2a, lsize=lsize) call mct_aVect_zero(x2a) ! Initialize internal attribute vectors for optional streams @@ -730,6 +743,9 @@ subroutine datm_comp_init(x2a, a2x, & call t_stopf('datm_initmctavs') + nxg = SDATM%nxg + nyg = SDATM%nyg + !---------------------------------------------------------------------------- ! Read restart !---------------------------------------------------------------------------- @@ -787,27 +803,11 @@ subroutine datm_comp_init(x2a, a2x, & !---------------------------------------------------------------------------- call t_adj_detailf(+2) - call datm_comp_run(& - x2a=x2a, & - a2x=a2x, & - SDATM=SDATM, & - mpicom=mpicom, & - compid=compid, & - my_task=my_task, & - master_task=master_task, & - inst_suffix=inst_suffix, & - logunit=logunit, & - orbEccen=orbEccen, & - orbMvelpp=orbMvelpp, & - orbLambm0=orbLambm0, & - orbObliqr=orbObliqr, & - write_restart=.false., & - target_ymd=current_ymd, & - target_tod=current_tod, & - target_mon=current_mon, & - calendar=calendar, & - modeldt=modeldt, & - atm_prognostic=atm_prognostic) + call datm_comp_run(mpicom=mpicom, compid=compid, my_task=my_task, & + master_task=master_task, inst_suffix=inst_suffix, logunit=logunit, & + orbEccen=orbEccen, orbMvelpp=orbMvelpp, orbLambm0=orbLambm0, orbObliqr=orbObliqr, & + write_restart=.false., target_ymd=current_ymd, target_tod=current_tod, target_mon=current_mon, & + calendar=calendar, modeldt=modeldt, atm_prognostic=atm_prognostic) call t_adj_detailf(-2) call t_stopf('DATM_INIT') @@ -816,8 +816,7 @@ end subroutine datm_comp_init !=============================================================================== - subroutine datm_comp_run(x2a, a2x, & - SDATM, mpicom, compid, my_task, master_task, & + subroutine datm_comp_run(mpicom, compid, my_task, master_task, & inst_suffix, logunit, & orbEccen, orbMvelpp, orbLambm0, orbObliqr, & write_restart, target_ymd, target_tod, target_mon, modeldt, calendar, & @@ -826,9 +825,6 @@ subroutine datm_comp_run(x2a, a2x, & ! !DESCRIPTION: run method for datm model ! !INPUT/OUTPUT PARAMETERS: - type(mct_aVect) , intent(inout) :: x2a - type(mct_aVect) , intent(inout) :: a2x - type(shr_strdata_type) , intent(inout) :: SDATM integer , intent(in) :: mpicom ! mpi communicator integer , intent(in) :: compid ! mct comp id integer , intent(in) :: my_task ! my task in mpi communicator mpicom @@ -877,7 +873,7 @@ subroutine datm_comp_run(x2a, a2x, & if (debug_import > 0 .and. my_task == master_task .and. atm_prognostic) then do nfld = 1, mct_aVect_nRAttr(x2a) - call shr_string_listGetName(trim(flds_x2a_mod), nfld, fldname) + call shr_string_listGetName(trim(flds_x2a), nfld, fldname) do n = 1, mct_aVect_lsize(x2a) write(logunit,F0D)'import: ymd,tod,n = '// trim(fldname),target_ymd, target_tod, & n, x2a%rattr(nfld,n) @@ -1385,7 +1381,7 @@ subroutine datm_comp_run(x2a, a2x, & if (debug_export > 0 .and. my_task == master_task) then do nfld = 1, mct_aVect_nRAttr(a2x) - call shr_string_listGetName(trim(flds_a2x_mod), nfld, fldname) + call shr_string_listGetName(trim(flds_a2x), nfld, fldname) do n = 1, mct_aVect_lsize(a2x) write(logunit,F0D)'export: ymd,tod,n = '// trim(fldname),target_ymd, target_tod, & n, a2x%rattr(nfld,n) @@ -1426,4 +1422,227 @@ subroutine datm_comp_run(x2a, a2x, & end subroutine datm_comp_run + !=============================================================================== + + subroutine datm_comp_import(importState, rc) + + ! input/output variables + type(ESMF_State) :: importState + integer, intent(out) :: rc + + ! local variables + integer :: k + !---------------------------------------------------------------- + + k = mct_aVect_indexRA(x2a, 'Sx_avsdr') + call dshr_import(importState, 'Sx_avsdr', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Sx_avsdf') + call dshr_import(importState, 'Sx_avsdf', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Sx_ansdr') + call dshr_import(importState, 'Sx_anidr', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Sx_anidf') + call dshr_import(importState, 'Sx_anidf', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Sx_tref') + call dshr_import(importState, 'Sx_tref', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Sx_qref') + call dshr_import(importState, 'Sx_qref', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Sx_t') + call dshr_import(importState, 'Sx_t', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'So_t') + call dshr_import(importState, 'So_t', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Sl_snowh') + call dshr_import(importState, 'Sl_snowh', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Sl_lfrac') + call dshr_import(importState, 'Sl_lfrac', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Si_lfrac') + call dshr_import(importState, 'Si_lfrac', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'So_ofrac') + call dshr_import(importState, 'So_ofrac', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Faxx_taux') + call dshr_import(importState, 'Faxx_taux', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Faxx_tauy') + call dshr_import(importState, 'Faxx_tauy', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Faxx_lat') + call dshr_import(importState, 'Faxx_lat', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Faxx_sen') + call dshr_import(importState, 'Faxx_sen', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Faxx_lwup') + call dshr_import(importState, 'Faxx_lwup', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Faxx_evap') + call dshr_import(importState, 'Faxx_evap', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine datm_comp_import + + !=============================================================================== + + subroutine datm_comp_export(exportState, rc) + + ! input/output variables + type(ESMF_State) :: exportState + integer, intent(out) :: rc + + ! local variables + integer :: k + !---------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call dshr_export(a2x%rattr(ktopo,:) , exportState, 'Sa_topo', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kz,:) , exportState, 'Sa_z', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(ku,:) , exportState, 'Sa_u', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kv,:) , exportState, 'Sa_v', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kptem,:) , exportState, 'Sa_ptem', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kdens,:) , exportState, 'Sa_dens', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kpslv,:) , exportState, 'Sa_pslv', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(ktbot,:) , exportState, 'Sa_tbot', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kpbot,:) , exportState, 'Sa_pbot', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kshum,:) , exportState, 'Sa_shum', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(a2x%rattr(krc,:) , exportState, 'Faxa_rainc', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(krl,:) , exportState, 'Faxa_rainl', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(ksc,:) , exportState, 'Faxa_snowc', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(ksl,:) , exportState, 'Faxa_snowl', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(a2x%rattr(kswndr,:), exportState, 'Faxa_swndr', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kswndf,:), exportState, 'Faxa_swndf', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kswvdr,:), exportState, 'Faxa_swvdr', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kswvdf,:), exportState, 'Faxa_swvdf', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kswnet,:), exportState, 'Faxa_swnet', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(klwdn,:) , exportState, 'Faxa_lwdn', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (flds_co2a .or. flds_co2b .or. flds_co2c) then + call dshr_export(avstrm%rattr(sco2p,:), exportState, 'Sa_co2prog' , rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(avstrm%rattr(sco2d,:), exportState, 'Sa_co2diag' , rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + if (presaero) then + call dshr_export(a2x%rattr(kbcphidry,:), exportState, 'Faxa_bcph', ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kbcphodry,:), exportState, 'Faxa_bcph', ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kbcphiwet,:), exportState, 'Faxa_bcph', ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(a2x%rattr(kocphidry,:), exportState, 'Faxa_ocph', ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kocphodry,:), exportState, 'Faxa_ocph', ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kocphiwet,:), exportState, 'Faxa_ocph', ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(a2x%rattr(kdstwet1,:), exportState, 'Faxa_dstwet', ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kdstwet2,:), exportState, 'Faxa_dstwet', ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kdstwet3,:), exportState, 'Faxa_dstwet', ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kdstwet4,:), exportState, 'Faxa_dstwet', ungridded_index=4, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(a2x%rattr(kdstdry1,:), exportState, 'Faxa_dstdry', ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kdstdry2,:), exportState, 'Faxa_dstdry', ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kdstdry3,:), exportState, 'Faxa_dstdry', ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kdstdry4,:), exportState, 'Faxa_dstdry', ungridded_index=4, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + if (flds_wiso) then + call dshr_export(a2x%rattr(krc_16O,:), exportState, 'Faxa_rainc_wiso', ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(krc_18O,:), exportState, 'Faxa_rainc_wiso', ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(krc_HDO,:), exportState, 'Faxa_rainc_wiso', ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(a2x%rattr(krl_16O,:), exportState, 'Faxa_rainl_wiso', ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(krl_18O,:), exportState, 'Faxa_rainl_wiso', ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(krl_HDO,:), exportState, 'Faxa_rainl_wiso', ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(a2x%rattr(ksc_16O,:), exportState, 'Faxa_snowc_wiso', ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(ksc_18O,:), exportState, 'Faxa_snowc_wiso', ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(ksc_HDO,:), exportState, 'Faxa_snowc_wiso', ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(a2x%rattr(ksl_16O,:), exportState, 'Faxa_snowl_wiso', ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(ksl_18O,:), exportState, 'Faxa_snowl_wiso', ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(ksl_HDO,:), exportState, 'Faxa_snowl_wiso', ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(a2x%rattr(kshum_16O,:), exportState, 'Faxa_shum_wiso', ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kshum_18O,:), exportState, 'Faxa_shum_wiso', ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kshum_HDO,:), exportState, 'Faxa_shum_wiso', ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + end subroutine datm_comp_export + end module datm_comp_mod diff --git a/src/components/data_comps/datm/nuopc/datm_shr_mod.F90 b/src/components/data_comps/datm/nuopc/datm_shr_mod.F90 index 3f06aef6bcd4..a08b4f08aaf2 100644 --- a/src/components/data_comps/datm/nuopc/datm_shr_mod.F90 +++ b/src/components/data_comps/datm/nuopc/datm_shr_mod.F90 @@ -38,6 +38,9 @@ module datm_shr_mod ! Note that model decomp will now come from reading in the mesh directly + ! stream data type + type(shr_strdata_type), public :: SDATM + ! input namelist variables character(CL) , public :: restfilm ! model restart file namelist character(CL) , public :: restfils ! stream restart file namelist @@ -60,7 +63,7 @@ module datm_shr_mod !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ subroutine datm_shr_read_namelists(filename, mpicom, my_task, master_task, & - logunit, SDATM, atm_prognostic) + logunit, atm_prognostic) ! !INPUT/OUTPUT PARAMETERS: character(len=*) , intent(in) :: filename ! input namelist filename @@ -68,7 +71,6 @@ subroutine datm_shr_read_namelists(filename, mpicom, my_task, master_task, & integer(IN) , intent(in) :: my_task ! my task in mpi communicator mpicom integer(IN) , intent(in) :: master_task ! task number of master task integer(IN) , intent(in) :: logunit ! logging unit number - type(shr_strdata_type) , intent(inout) :: SDATM logical , intent(out) :: atm_prognostic ! flag !--- local variables --- diff --git a/src/components/data_comps/dice/nuopc/dice_comp_mod.F90 b/src/components/data_comps/dice/nuopc/dice_comp_mod.F90 index 9a46b3a60c84..387752c137c7 100644 --- a/src/components/data_comps/dice/nuopc/dice_comp_mod.F90 +++ b/src/components/data_comps/dice/nuopc/dice_comp_mod.F90 @@ -30,7 +30,7 @@ module dice_comp_mod use shr_strdata_mod , only : shr_strdata_print, shr_strdata_restRead use shr_strdata_mod , only : shr_strdata_advance, shr_strdata_restWrite use shr_dmodel_mod , only : shr_dmodel_translateAV - use dshr_nuopc_mod , only : fld_list_type, dshr_fld_add + use dshr_nuopc_mod , only : fld_list_type, dshr_fld_add, dshr_import, dshr_export use dice_shr_mod , only : datamode ! namelist input use dice_shr_mod , only : rest_file ! namelist input use dice_shr_mod , only : rest_file_strm ! namelist input @@ -39,6 +39,7 @@ module dice_comp_mod use dice_shr_mod , only : flux_Qacc ! namelist input -activates water accumulation/melt wrt Q use dice_shr_mod , only : flux_Qacc0 ! namelist input -initial water accumulation value use dice_shr_mod , only : nullstr + use dice_shr_mod , only : SDICE use dice_flux_atmice_mod , only : dice_flux_atmice use shr_pcdf_mod @@ -53,11 +54,18 @@ module dice_comp_mod public :: dice_comp_advertise public :: dice_comp_init public :: dice_comp_run + public :: dice_comp_import + public :: dice_comp_export !-------------------------------------------------------------------------- ! Private data !-------------------------------------------------------------------------- + type(mct_aVect) :: x2i + type(mct_aVect) :: i2x + character(CXX) :: flds_i2x = '' + character(CXX) :: flds_x2i = '' + integer :: debug_import = 0 ! debug level (if > 0 will print all import fields) integer :: debug_export = 0 ! debug level (if > 0 will print all export fields) @@ -106,8 +114,6 @@ module dice_comp_mod character(len=CS), pointer :: strmifld(:) character(len=CS), pointer :: strmofld(:) character(len=CXX) :: flds_strm = '' ! colon deliminated string of field names - character(len=CXX) :: flds_i2x_mod - character(len=CXX) :: flds_x2i_mod logical :: firstcall = .true. ! first call logical character(len=*),parameter :: rpfile = 'rpointer.ice' @@ -120,8 +126,7 @@ module dice_comp_mod subroutine dice_comp_advertise(importState, exportState, & ice_present, ice_prognostic, & - fldsFrIce_num, fldsFrIce, fldsToIce_num, fldsToIce, & - flds_i2x, flds_x2i, rc) + fldsFrIce_num, fldsFrIce, fldsToIce_num, fldsToIce, rc) ! input/output arguments type(ESMF_State) , intent(inout) :: importState @@ -132,8 +137,6 @@ subroutine dice_comp_advertise(importState, exportState, & integer , intent(out) :: fldsFrIce_num type (fld_list_type) , intent(out) :: fldsToIce(:) type (fld_list_type) , intent(out) :: fldsFrIce(:) - character(len=*) , intent(out) :: flds_i2x - character(len=*) , intent(out) :: flds_x2i integer , intent(out) :: rc ! local variables @@ -150,6 +153,10 @@ subroutine dice_comp_advertise(importState, exportState, & fldsFrIce(1)%stdname = trim(flds_scalar_name) ! export fields that have a corresponding stream field + ! - model_fld_index sets the module variables kiFrac + ! - model_fld_concat variable sets the output variable flds_i2x + ! - model_fld_array sets the module character array avofld + ! - data_fld_array sets the module character array avifld call dshr_fld_add(data_fld='ifrac', data_fld_array=avifld, model_fld='Si_ifrac', model_fld_array=avofld, & model_fld_concat=flds_i2x, model_fld_index=kiFrac, fldlist_num=fldsFrIce_num, fldlist=fldsFrIce) @@ -276,47 +283,31 @@ subroutine dice_comp_advertise(importState, exportState, & call dshr_fld_add(model_fld='So_s', model_fld_concat=flds_x2i, model_fld_index=ksalinity, & fldlist_num=fldsToIce_num, fldlist=fldsToIce) - call dshr_fld_add(model_fld='Faxa_bcphidry', model_fld_concat=flds_x2i, model_fld_index=kbcphidry, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_bcphodry', model_fld_concat=flds_x2i, model_fld_index=kbcphodry, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_bcphiwet', model_fld_concat=flds_x2i, model_fld_index=kbcphiwet, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_ocphidry', model_fld_concat=flds_x2i, model_fld_index=kocphidry, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_ocphodry', model_fld_concat=flds_x2i, model_fld_index=kocphodry, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_ocphiwet', model_fld_concat=flds_x2i, model_fld_index=kocphiwet, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_dstdry1', model_fld_concat=flds_x2i, model_fld_index=kdstdry1, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_dstdry2', model_fld_concat=flds_x2i, model_fld_index=kdstdry2, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_dstdry3', model_fld_concat=flds_x2i, model_fld_index=kdstdry3, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_dstdry4', model_fld_concat=flds_x2i, model_fld_index=kdstdry4, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_dstwet1', model_fld_concat=flds_x2i, model_fld_index=kdstwet1, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_dstwet2', model_fld_concat=flds_x2i, model_fld_index=kdstwet2, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_dstwet3', model_fld_concat=flds_x2i, model_fld_index=kdstwet3, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_dstwet4', model_fld_concat=flds_x2i, model_fld_index=kdstwet4, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) + call dshr_fld_add(model_fld='Faxa_bcphidry', model_fld_concat=flds_x2i, model_fld_index=kbcphidry) + call dshr_fld_add(model_fld='Faxa_bcphodry', model_fld_concat=flds_x2i, model_fld_index=kbcphodry) + call dshr_fld_add(model_fld='Faxa_bcphiwet', model_fld_concat=flds_x2i, model_fld_index=kbcphiwet) + call dshr_fld_add(med_fld='Faxa_bcph', fldlist_num=fldsToIce_num, fldlist=fldsToIce, & + ungridded_lbound=1, ungridded_ubound=3) + + call dshr_fld_add(model_fld='Faxa_ocphidry', model_fld_concat=flds_x2i, model_fld_index=kocphidry) + call dshr_fld_add(model_fld='Faxa_ocphodry', model_fld_concat=flds_x2i, model_fld_index=kocphodry) + call dshr_fld_add(model_fld='Faxa_ocphiwet', model_fld_concat=flds_x2i, model_fld_index=kocphiwet) + call dshr_fld_add(med_fld='Faxa_ocph', fldlist_num=fldsToIce_num, fldlist=fldsToIce, & + ungridded_lbound=1, ungridded_ubound=3) + + call dshr_fld_add(model_fld='Faxa_dstdry1', model_fld_concat=flds_x2i, model_fld_index=kdstdry1) + call dshr_fld_add(model_fld='Faxa_dstdry2', model_fld_concat=flds_x2i, model_fld_index=kdstdry2) + call dshr_fld_add(model_fld='Faxa_dstdry3', model_fld_concat=flds_x2i, model_fld_index=kdstdry3) + call dshr_fld_add(model_fld='Faxa_dstdry4', model_fld_concat=flds_x2i, model_fld_index=kdstdry4) + call dshr_fld_add(med_fld='Faxa_dstdry', fldlist_num=fldsToIce_num, fldlist=fldsToIce, & + ungridded_lbound=1, ungridded_ubound=4) + + call dshr_fld_add(model_fld='Faxa_dstwet1', model_fld_concat=flds_x2i, model_fld_index=kdstwet1) + call dshr_fld_add(model_fld='Faxa_dstwet2', model_fld_concat=flds_x2i, model_fld_index=kdstwet2) + call dshr_fld_add(model_fld='Faxa_dstwet3', model_fld_concat=flds_x2i, model_fld_index=kdstwet3) + call dshr_fld_add(model_fld='Faxa_dstwet4', model_fld_concat=flds_x2i, model_fld_index=kdstwet4) + call dshr_fld_add(med_fld='Faxa_dstwet', fldlist_num=fldsToIce_num, fldlist=fldsToIce, & + ungridded_lbound=1, ungridded_ubound=4) end if @@ -334,29 +325,18 @@ subroutine dice_comp_advertise(importState, exportState, & enddo end if - ! Save flds_x2i and flds_i2x as module variables for use in debugging - - flds_x2i_mod = trim(flds_x2i) - flds_i2x_mod = trim(flds_i2x) - end subroutine dice_comp_advertise !=============================================================================== - subroutine dice_comp_init(x2i, i2x, & - flds_x2i_fields, flds_i2x_fields, flds_i2o_per_cat, & - SDICE, mpicom, compid, my_task, master_task, & + subroutine dice_comp_init(flds_i2o_per_cat, mpicom, compid, my_task, master_task, & inst_suffix, inst_name, logunit, read_restart, & - scmMode, scmlat, scmlon, calendar, mesh) + scmMode, scmlat, scmlon, calendar, mesh, nxg, nyg) ! !DESCRIPTION: initialize dice model ! input/output parameters: - type(mct_aVect) , intent(inout) :: x2i, i2x ! input/output attribute vectors - character(len=*) , intent(in) :: flds_x2i_fields ! fields from mediator - character(len=*) , intent(in) :: flds_i2x_fields ! fields to mediator logical , intent(in) :: flds_i2o_per_cat ! .true. if select per ice thickness fields from ice - type(shr_strdata_type) , intent(inout) :: SDICE ! dice shr_strdata instance (output) integer , intent(in) :: mpicom ! mpi communicator integer , intent(in) :: compid ! mct comp id integer , intent(in) :: my_task ! my task in mpi communicator mpicom @@ -370,6 +350,7 @@ subroutine dice_comp_init(x2i, i2x, & real(R8) , intent(in) :: scmLon ! single column lon character(len=*) , intent(in) :: calendar ! calendar type type(ESMF_Mesh) , intent(in) :: mesh ! ESMF dice mesh + integer , intent(out) :: nxg, nyg !--- local variables --- integer :: n,k ! generic counters @@ -520,7 +501,7 @@ subroutine dice_comp_init(x2i, i2x, & call t_startf('dice_initmctavs') if (my_task == master_task) write(logunit,F00) 'allocate AVs' - call mct_aVect_init(i2x, rList=flds_i2x_fields, lsize=lsize) + call mct_aVect_init(i2x, rList=flds_i2x, lsize=lsize) call mct_aVect_zero(i2x) ! optional per thickness category fields @@ -529,7 +510,7 @@ subroutine dice_comp_init(x2i, i2x, & kswpen_iFrac_01 = mct_aVect_indexRA(i2x,'PFioi_swpen_ifrac_01') end if - call mct_aVect_init(x2i, rList=flds_x2i_fields, lsize=lsize) + call mct_aVect_init(x2i, rList=flds_x2i, lsize=lsize) call mct_aVect_zero(x2i) allocate(water(lsize)) @@ -542,6 +523,9 @@ subroutine dice_comp_init(x2i, i2x, & call t_stopf('dice_initmctavs') + nxg = SDICE%nxg + nyg = SDICE%nyg + !---------------------------------------------------------------------------- ! Read restart !---------------------------------------------------------------------------- @@ -613,18 +597,14 @@ end subroutine dice_comp_init !=============================================================================== - subroutine dice_comp_run(x2i, i2x, flds_i2o_per_cat, & - SDICE, mpicom, my_task, master_task, & + subroutine dice_comp_run(flds_i2o_per_cat, mpicom, my_task, master_task, & inst_suffix, logunit, read_restart, write_restart, & calendar, modeldt, target_ymd, target_tod, cosArg, case_name ) ! !DESCRIPTION: run method for dice model ! input/output parameters: - type(mct_aVect) , intent(inout) :: x2i - type(mct_aVect) , intent(inout) :: i2x logical , intent(in) :: flds_i2o_per_cat ! .true. if select per ice thickness fields from ice - type(shr_strdata_type) , intent(inout) :: SDICE integer , intent(in) :: mpicom ! mpi communicator integer , intent(in) :: my_task ! my task in mpi communicator mpicom integer , intent(in) :: master_task ! task number of master task @@ -660,7 +640,7 @@ subroutine dice_comp_run(x2i, i2x, flds_i2o_per_cat, & if (debug_import > 1 .and. my_task == master_task) then do nfld = 1, mct_aVect_nRAttr(x2i) - call shr_string_listGetName(trim(flds_x2i_mod), nfld, fldname) + call shr_string_listGetName(trim(flds_x2i), nfld, fldname) do n = 1, mct_aVect_lsize(x2i) write(logunit,F0D)'import: ymd,tod,n = '// trim(fldname),target_ymd, target_tod, & n, x2i%rattr(nfld,n) @@ -802,7 +782,7 @@ subroutine dice_comp_run(x2i, i2x, flds_i2o_per_cat, & end do - ! compute atm/ice surface fluxes + ! compute ice/ice surface fluxes call dice_flux_atmice( & iMask ,x2i%rAttr(kz,:) ,x2i%rAttr(kua,:) ,x2i%rAttr(kva,:) , & x2i%rAttr(kptem,:) ,x2i%rAttr(kshum,:) ,x2i%rAttr(kdens,:) ,x2i%rAttr(ktbot,:), & @@ -869,7 +849,7 @@ subroutine dice_comp_run(x2i, i2x, flds_i2o_per_cat, & if (debug_export > 1 .and. my_task == master_task) then do nfld = 1, mct_aVect_nRAttr(i2x) - call shr_string_listGetName(trim(flds_i2x_mod), nfld, fldname) + call shr_string_listGetName(trim(flds_i2x), nfld, fldname) do n = 1, mct_aVect_lsize(i2x) write(logunit,F0D)'export: ymd,tod,n = '// trim(fldname),target_ymd, target_tod, & n, i2x%rattr(nfld,n) @@ -914,4 +894,160 @@ subroutine dice_comp_run(x2i, i2x, flds_i2o_per_cat, & end subroutine dice_comp_run + !=============================================================================== + + subroutine dice_comp_import(importState, rc) + + ! input/output variables + type(ESMF_State) :: importState + integer, intent(out) :: rc + + ! local variables + integer :: k + !---------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call dshr_import(importState, 'Sa_z', x2i%rattr(kz,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Sa_u', x2i%rattr(kua,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Sa_v', x2i%rattr(kva,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Sa_ptem', x2i%rattr(kptem,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Sa_dens', x2i%rattr(kdens,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Sa_tbot', x2i%rattr(ktbot,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Sa_shum', x2i%rattr(kshum,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Faxa_swndr' , x2i%rattr(kswndr,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_swndf' , x2i%rattr(kswndf,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_swvdr' , x2i%rattr(kswvdr,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_swvdf' , x2i%rattr(kswvdf,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Faxa_bcph', x2i%rattr(kbcphidry,:), ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_bcph', x2i%rattr(kbcphodry,:), ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_bcph', x2i%rattr(kbcphiwet,:), ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Faxa_ocph', x2i%rattr(kocphidry,:), ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_ocph', x2i%rattr(kocphodry,:), ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_ocph', x2i%rattr(kocphiwet,:), ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Faxa_dstwet', x2i%rattr(kdstwet1,:), ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_dstwet', x2i%rattr(kdstwet2,:), ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_dstwet', x2i%rattr(kdstwet3,:), ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_dstwet', x2i%rattr(kdstwet4,:), ungridded_index=4, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Faxa_dstdry', x2i%rattr(kdstdry1,:), ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_dstdry', x2i%rattr(kdstdry2,:), ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_dstdry', x2i%rattr(kdstdry3,:), ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_dstdry', x2i%rattr(kdstdry4,:), ungridded_index=4, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Fioo_q' , x2i%rattr(kq,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'So_s' , x2i%rattr(ksalinity,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine dice_comp_import + + !=============================================================================== + + subroutine dice_comp_export(exportState, rc) + + ! input/output variables + type(ESMF_State) :: exportState + integer, intent(out) :: rc + + ! local variables + integer :: k + !---------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call dshr_export(i2x%rattr(kiFrac,:) , exportState, 'Si_ifrac', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(km,:) , exportState, 'Si_imask', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(kt,:), exportState, 'Si_t', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(ktref,:), exportState, 'Si_tref' , rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(kqref,:), exportState, 'Si_qref', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(kavsdr,:), exportState, 'Si_avsdr', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(kanidr,:), exportState, 'Si_anidr', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(kavsdf,:), exportState, 'Si_avsdf', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(kanidf,:), exportState, 'Si_anidf', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(kswnet,:), exportState, 'Faii_swnet', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(ksen,:), exportState, 'Faii_sen', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(klat,:), exportState, 'Faii_lat', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(klwup,:), exportState, 'Faii_lwup', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(kevap,:), exportState, 'Faii_evap', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(ktauxa,:), exportState, 'Faii_taux', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(ktauya,:), exportState, 'Faii_tauy', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(kmelth,:), exportState, 'Fioi_melth', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(kmeltw,:), exportState, 'Fioi_meltw', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(kswpen,:), exportState, 'Fioi_swpen', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(ktauxo,:), exportState, 'Fioi_taux', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(ktauyo,:), exportState, 'Fioi_tauy', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(ksalt,:), exportState, 'Fioi_salt', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(kbcpho,:), exportState, 'Fioi_bcpho', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(kbcphi,:), exportState, 'Fioi_bcphi', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(kflxdst,:), exportState, 'Fioi_flxdst', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine dice_comp_export + end module dice_comp_mod diff --git a/src/components/data_comps/dice/nuopc/dice_shr_mod.F90 b/src/components/data_comps/dice/nuopc/dice_shr_mod.F90 index 5744f57e80a9..4cc947f5dda3 100644 --- a/src/components/data_comps/dice/nuopc/dice_shr_mod.F90 +++ b/src/components/data_comps/dice/nuopc/dice_shr_mod.F90 @@ -25,6 +25,9 @@ module dice_shr_mod ! Note that model decomp will now come from reading in the mesh directly + ! stream data type + type(shr_strdata_type), public :: SDICE + ! input namelist variables character(CL) , public :: restfilm ! model restart file namelist character(CL) , public :: restfils ! stream restart file namelist @@ -44,7 +47,7 @@ module dice_shr_mod !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ subroutine dice_shr_read_namelists(filename, mpicom, my_task, master_task, & - logunit, SDICE, ice_present, ice_prognostic) + logunit, ice_present, ice_prognostic) ! !DESCRIPTION: Read in dice namelists implicit none @@ -55,7 +58,6 @@ subroutine dice_shr_read_namelists(filename, mpicom, my_task, master_task, & integer(IN) , intent(in) :: my_task ! my task in mpi communicator mpicom integer(IN) , intent(in) :: master_task ! task number of master task integer(IN) , intent(in) :: logunit ! logging unit number - type(shr_strdata_type) , intent(inout) :: SDICE logical , intent(out) :: ice_present ! flag logical , intent(out) :: ice_prognostic ! flag diff --git a/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 b/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 index 794ea07dafd7..c6064bdd9e77 100644 --- a/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 +++ b/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 @@ -26,18 +26,14 @@ module ice_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - use shr_nuopc_grid_mod , only : shr_nuopc_grid_ArrayToState - use shr_nuopc_grid_mod , only : shr_nuopc_grid_StateToArray - use shr_const_mod , only : SHR_CONST_SPVAL + use shr_const_mod , only : shr_const_spval, shr_const_pi use shr_strdata_mod , only : shr_strdata_type use shr_cal_mod , only : shr_cal_ymd2julian - use shr_const_mod , only : shr_const_pi - use dshr_nuopc_mod , only : fld_list_type, fldsMax, fld_list_realize + use dshr_nuopc_mod , only : fld_list_type, fldsMax, dshr_realize use dshr_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, ModelSetMetaData use dice_shr_mod , only : dice_shr_read_namelists use dice_comp_mod , only : dice_comp_init, dice_comp_run, dice_comp_advertise - use mct_mod , only : mct_Avect, mct_Avect_info - + use dice_comp_mod , only : dice_comp_import, dice_comp_export implicit none private ! except @@ -57,9 +53,7 @@ module ice_comp_nuopc integer :: fldsFrIce_num = 0 type (fld_list_type) :: fldsToIce(fldsMax) type (fld_list_type) :: fldsFrIce(fldsMax) - type(shr_strdata_type) :: SDICE - type(mct_aVect) :: x2i - type(mct_aVect) :: i2x + integer :: compid ! mct comp id integer :: mpicom ! mpi communicator integer :: my_task ! my task in mpi communicator mpicom @@ -70,13 +64,10 @@ module ice_comp_nuopc integer, parameter :: master_task=0 ! task number of master task logical :: read_restart ! start from restart character(len=256) :: case_name ! case name - integer :: dbrc logical :: flds_i2o_per_cat ! .true. if select per ice thickness ! category fields are passed from ice to ocean character(len=80) :: calendar ! calendar name integer :: modeldt ! integer timestep - character(len=CXX) :: flds_i2x = '' - character(len=CXX) :: flds_x2i = '' logical :: use_esmf_metadata = .false. real(R8) ,parameter :: pi = shr_const_pi ! pi character(*),parameter :: modName = "(ice_comp_nuopc)" @@ -95,7 +86,7 @@ subroutine SetServices(gcomp, rc) character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) @@ -131,7 +122,7 @@ subroutine SetServices(gcomp, rc) specRoutine=ModelFinalize, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine SetServices @@ -165,7 +156,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! generate local mpi comm @@ -199,7 +190,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) filename = "dice_in"//trim(inst_suffix) call dice_shr_read_namelists(filename, mpicom, my_task, master_task, & - logunit, SDICE, ice_present, ice_prognostic) + logunit, ice_present, ice_prognostic) !-------------------------------- ! Advertise import and export fields @@ -207,8 +198,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call dice_comp_advertise(importstate, exportState, & ice_present, ice_prognostic, & - fldsFrIce_num, fldsFrIce, fldsToIce_num, fldsToIce, & - flds_i2x, flds_x2i, rc) + fldsFrIce_num, fldsFrIce, fldsToIce_num, fldsToIce, rc) !---------------------------------------------------------------------------- ! Reset shr logging to original values @@ -217,7 +207,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call shr_file_setLogUnit (shrlogunit) call shr_file_setLogLevel(shrloglev) - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine InitializeAdvertise @@ -251,11 +241,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) real(R8) :: cosarg ! for setting ice temp pattern real(R8) :: jday, jday0 ! elapsed day counters logical :: write_restart + integer :: nxg, nyg character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! Reset shr logging to my log file @@ -310,7 +301,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) calendar = shr_cal_gregorian else call ESMF_LogWrite(subname//" ERROR bad ESMF calendar name "//trim(calendar), & - ESMF_LOGMSG_ERROR, rc=dbrc) + ESMF_LOGMSG_ERROR) rc = ESMF_Failure return end if @@ -329,11 +320,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Initialize model !-------------------------------- - call dice_comp_init(x2i, i2x, & - flds_x2i, flds_i2x, flds_i2o_per_cat, & - SDICE, mpicom, compid, my_task, master_task, & + call dice_comp_init(flds_i2o_per_cat, mpicom, compid, my_task, master_task, & inst_suffix, inst_name, logunit, read_restart, & - scmMode, scmlat, scmlon, calendar, Emesh) + scmMode, scmlat, scmlon, calendar, Emesh, nxg, nyg) !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -341,7 +330,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! by replacing the advertised fields with the newly created fields of the same name. !-------------------------------- - call fld_list_realize( & + call dshr_realize( & state=ExportState, & fldList=fldsFrIce, & numflds=fldsFrIce_num, & @@ -351,7 +340,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) mesh=Emesh, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call fld_list_realize( & + call dshr_realize( & state=importState, & fldList=fldsToIce, & numflds=fldsToIce_num, & @@ -381,22 +370,19 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) cosArg = 2.0_R8*pi*(jday - jday0)/365.0_R8 write_restart = .false. - call dice_comp_run(x2i, i2x, & - flds_i2o_per_cat, SDICE, mpicom, my_task, master_task, & + call dice_comp_run(flds_i2o_per_cat, mpicom, my_task, master_task, & inst_suffix, logunit, read_restart, write_restart, & calendar, modeldt, current_ymd, current_tod, cosArg) ! Pack export state - call shr_nuopc_grid_ArrayToState(i2x%rattr, flds_i2x, exportState, grid_option='mesh', rc=rc) + call dice_comp_export(exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - nx_global = SDICE%nxg - ny_global = SDICE%nyg - call shr_nuopc_methods_State_SetScalar(dble(nx_global),flds_scalar_index_nx, exportState, & + call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(ny_global),flds_scalar_index_ny, exportState, & + call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -421,7 +407,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine InitializeRealize @@ -454,7 +440,7 @@ subroutine ModelAdvance(gcomp, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) call shr_nuopc_memcheck(subname, 5, my_task==master_task) !-------------------------------- ! Reset shr logging to my log file @@ -480,7 +466,7 @@ subroutine ModelAdvance(gcomp, rc) ! Unpack import state !-------------------------------- - call shr_nuopc_grid_StateToArray(importState, x2i%rattr, flds_x2i, grid_option='mesh', rc=rc) + call dice_comp_import(importState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- @@ -520,8 +506,7 @@ subroutine ModelAdvance(gcomp, rc) ! Run dice read_restart = .false. - call dice_comp_run(x2i, i2x, & - flds_i2o_per_cat, SDICE, mpicom, my_task, master_task, & + call dice_comp_run(flds_i2o_per_cat, mpicom, my_task, master_task, & inst_suffix, logunit, read_restart, write_restart, & calendar, modeldt, next_ymd, next_tod, cosArg, case_name) @@ -529,7 +514,7 @@ subroutine ModelAdvance(gcomp, rc) ! Pack export state !-------------------------------- - call shr_nuopc_grid_ArrayToState(i2x%rattr, flds_i2x, exportState, grid_option='mesh', rc=rc) + call dice_comp_export(exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- @@ -545,7 +530,7 @@ subroutine ModelAdvance(gcomp, rc) call shr_nuopc_log_clock_advance(clock, 'ICE', logunit) end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! Reset shr logging to original values @@ -574,7 +559,7 @@ subroutine ModelFinalize(gcomp, rc) write(logunit,F00) ' dice: end of main integration loop' write(logunit,F91) end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine ModelFinalize diff --git a/src/components/data_comps/dlnd/nuopc/dlnd_comp_mod.F90 b/src/components/data_comps/dlnd/nuopc/dlnd_comp_mod.F90 index 14303ab81328..55520daf7c4f 100644 --- a/src/components/data_comps/dlnd/nuopc/dlnd_comp_mod.F90 +++ b/src/components/data_comps/dlnd/nuopc/dlnd_comp_mod.F90 @@ -30,14 +30,14 @@ module dlnd_comp_mod use shr_cal_mod , only : shr_cal_datetod2string use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use dshr_nuopc_mod , only : fld_list_type - use dshr_nuopc_mod , only : dshr_fld_add - use glc_elevclass_mod , only : glc_get_num_elevation_classes, glc_elevclass_as_string, glc_elevclass_init + use dshr_nuopc_mod , only : fld_list_type, dshr_fld_add, dshr_import, dshr_export + use glc_elevclass_mod , only : glc_elevclass_as_string, glc_elevclass_init use dlnd_shr_mod , only : datamode ! namelist input use dlnd_shr_mod , only : rest_file ! namelist input use dlnd_shr_mod , only : rest_file_strm ! namelist input use dlnd_shr_mod , only : domain_fracname ! namelist input use dlnd_shr_mod , only : nullstr + use dlnd_shr_mod , only : SDLND ! !PUBLIC TYPES: implicit none @@ -50,16 +50,20 @@ module dlnd_comp_mod public :: dlnd_comp_advertise public :: dlnd_comp_init public :: dlnd_comp_run + public :: dlnd_comp_export !-------------------------------------------------------------------------- ! Private data !-------------------------------------------------------------------------- + type(mct_aVect) :: x2l + type(mct_aVect) :: l2x character(len=CS), pointer :: avifld(:) ! char array field names coming from streams character(len=CS), pointer :: avofld(:) ! char array field names to be sent/recd from med - character(len=CXX) :: flds_l2x_mod - character(len=CXX) :: flds_x2l_mod + character(len=CXX) :: flds_l2x = '' + character(len=CXX) :: flds_x2l = '' integer :: kf ! index for frac in AV + integer :: glc_nec real(R8), pointer :: lfrac(:) ! land frac character(len=*), parameter :: rpfile = 'rpointer.lnd' integer , parameter :: nec_len = 2 ! length of elevation class index in field names @@ -71,26 +75,23 @@ module dlnd_comp_mod !=============================================================================== subroutine dlnd_comp_advertise(importState, exportState, & - lnd_present, lnd_prognostic, glc_nec, & - fldsFrLnd_num, fldsFrLnd, fldsToLnd_num, fldsToLnd, & - flds_l2x, flds_x2l, rc) + lnd_present, lnd_prognostic, glc_nec_in, & + fldsFrLnd_num, fldsFrLnd, fldsToLnd_num, fldsToLnd, rc) ! 1. determine export and import fields to advertise to mediator ! 2. determine translation of fields from streams to export/import fields ! input/output arguments - type(ESMF_State) :: importState - type(ESMF_State) :: exportState - integer , intent(in) :: glc_nec - logical , intent(in) :: lnd_present - logical , intent(in) :: lnd_prognostic - integer , intent(out) :: fldsFrLnd_num - type (fld_list_type) , intent(out) :: fldsFrLnd(:) - integer , intent(out) :: fldsToLnd_num - type (fld_list_type) , intent(out) :: fldsToLnd(:) - character(len=*) , intent(out) :: flds_l2x - character(len=*) , intent(out) :: flds_x2l - integer , intent(out) :: rc + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + integer , intent(in) :: glc_nec_in + logical , intent(in) :: lnd_present + logical , intent(in) :: lnd_prognostic + integer , intent(out) :: fldsFrLnd_num + type (fld_list_type) , intent(out) :: fldsFrLnd(:) + integer , intent(inout) :: fldsToLnd_num + type (fld_list_type) , intent(inout) :: fldsToLnd(:) + integer , intent(out) :: rc ! local variables integer :: n @@ -103,6 +104,10 @@ subroutine dlnd_comp_advertise(importState, exportState, & if (.not. lnd_present) return + glc_nec = glc_nec_in + + call glc_elevclass_init(glc_nec) + !------------------- ! export fields !------------------- @@ -112,11 +117,9 @@ subroutine dlnd_comp_advertise(importState, exportState, & fldsFrLnd_num=1 fldsFrLnd(1)%stdname = trim(flds_scalar_name) - call dshr_fld_add(model_fld="Sl_lfrin", model_fld_concat=flds_l2x, model_fld_index=kf, & - fldlist_num=fldsFrLnd_num, fldlist=fldsFrLnd) + call dshr_fld_add(model_fld="Sl_lfrin", model_fld_concat=flds_l2x, model_fld_index=kf) ! The actual snow field names will have the elevation class index at the end (e.g., Sl_tsrf01, tsrf01) - call glc_elevclass_init(glc_nec) if (glc_nec > 0) then do n = 0, glc_nec nec_str = glc_elevclass_as_string(n) @@ -124,73 +127,57 @@ subroutine dlnd_comp_advertise(importState, exportState, & data_fld_name = "tsrf" // nec_str model_fld_name = "Sl_tsrf" // nec_str call dshr_fld_add(data_fld=trim(data_fld_name), data_fld_array=avifld, & - model_fld=trim(model_fld_name), model_fld_array=avofld, & - model_fld_concat=flds_l2x, fldlist_num=fldsFrLnd_num, fldlist=fldsFrLnd) + model_fld=trim(model_fld_name), model_fld_array=avofld, model_fld_concat=flds_l2x) data_fld_name = "topo" // nec_str model_fld_name = "Sl_topo" // nec_str call dshr_fld_add(data_fld=trim(data_fld_name), data_fld_array=avifld, & - model_fld=trim(model_fld_name), model_fld_array=avofld, & - model_fld_concat=flds_l2x, fldlist_num=fldsFrLnd_num, fldlist=fldsFrLnd) + model_fld=trim(model_fld_name), model_fld_array=avofld, model_fld_concat=flds_l2x) data_fld_name = "qice" // nec_str model_fld_name = "Flgl_qice" // nec_str call dshr_fld_add(data_fld=trim(data_fld_name), data_fld_array=avifld, & - model_fld=trim(model_fld_name), model_fld_array=avofld, & - model_fld_concat=flds_l2x, fldlist_num=fldsFrLnd_num, fldlist=fldsFrLnd) + model_fld=trim(model_fld_name), model_fld_array=avofld, model_fld_concat=flds_l2x) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end do + + ! The following puts all of the elevation class fields as an + ! undidstributed dimension in the export state field + + call dshr_fld_add(med_fld="Sl_lfrin", fldlist_num=fldsFrLnd_num, fldlist=fldsFrLnd) + call dshr_fld_add(med_fld='Sl_tsrf_elev', fldlist_num=fldsFrLnd_num, fldlist=fldsFrLnd, & + ungridded_lbound=1, ungridded_ubound=glc_nec) + call dshr_fld_add(med_fld='Sl_topo_elev', fldlist_num=fldsFrLnd_num, fldlist=fldsFrLnd, & + ungridded_lbound=1, ungridded_ubound=glc_nec) + call dshr_fld_add(med_fld='Flgl_qice_elev', fldlist_num=fldsFrLnd_num, fldlist=fldsFrLnd, & + ungridded_lbound=1, ungridded_ubound=glc_nec) + end if ! Non snow fields that nead to be added if dlnd is in cplhist mode - ! "Sl_t " - ! "Sl_tref " - ! "Sl_qref " - ! "Sl_avsdr " - ! "Sl_anidr " - ! "Sl_avsdf " - ! "Sl_anidf " - ! "Sl_snowh " - ! "Fall_taux " - ! "Fall_tauy " - ! "Fall_lat " - ! "Fall_sen " - ! "Fall_lwup " - ! "Fall_evap " - ! "Fall_swnet " - ! "Sl_landfrac " - ! "Sl_fv " - ! "Sl_ram1 " - ! "Fall_flxdst1" - ! "Fall_flxdst2" - ! "Fall_flxdst3" - ! "Fall_flxdst4" + ! "Sl_t " "Sl_tref " "Sl_qref " "Sl_avsdr " + ! "Sl_anidr " "Sl_avsdf " "Sl_anidf " "Sl_snowh " + ! "Fall_taux " "Fall_tauy " "Fall_lat " "Fall_sen " + ! "Fall_lwup " "Fall_evap " "Fall_swnet " "Sl_landfrac " + ! "Sl_fv " "Sl_ram1 " + ! "Fall_flxdst1" "Fall_flxdst2" "Fall_flxdst3" "Fall_flxdst4" do n = 1,fldsFrLnd_num call NUOPC_Advertise(exportState, standardName=fldsFrLnd(n)%stdname, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return enddo - !------------------- - ! Save flds_l2x and flds_x2l as module variables for use in debugging - !------------------- - - flds_x2l_mod = trim(flds_x2l) - flds_l2x_mod = trim(flds_l2x) - end subroutine dlnd_comp_advertise !=============================================================================== - subroutine dlnd_comp_init(x2l, l2x, & - SDLND, mpicom, compid, my_task, master_task, & + subroutine dlnd_comp_init(mpicom, compid, my_task, master_task, & inst_suffix, logunit, read_restart, & - scmMode, scmlat, scmlon, calendar, current_ymd, current_tod, mesh) + scmMode, scmlat, scmlon, calendar, current_ymd, current_tod, mesh, nxg, nyg) ! !DESCRIPTION: initialize dlnd model ! !INPUT/OUTPUT PARAMETERS: - type(mct_aVect) , intent(inout) :: x2l, l2x ! input/output attribute vectors - type(shr_strdata_type) , intent(inout) :: SDLND ! model shr_strdata instance (output) integer , intent(in) :: mpicom ! mpi communicator integer , intent(in) :: compid ! mct comp id integer , intent(in) :: my_task ! my task in mpi communicator mpicom @@ -205,6 +192,7 @@ subroutine dlnd_comp_init(x2l, l2x, & integer , intent(in) :: current_ymd ! model date integer , intent(in) :: current_tod ! model sec into model date type(ESMF_Mesh) , intent(in) :: mesh ! ESMF docn mesh + integer , intent(out) :: nxg, nyg ! global size of model grid !--- local variables --- integer :: n,k ! generic counters @@ -356,12 +344,14 @@ subroutine dlnd_comp_init(x2l, l2x, & !---------------------------------------------------------------------------- if (my_task == master_task) write(logunit,F00) 'allocate AVs' - - call mct_aVect_init(l2x, rList=flds_l2x_mod, lsize=lsize) + call mct_aVect_init(l2x, rList=flds_l2x, lsize=lsize) call mct_aVect_zero(l2x) - call mct_aVect_init(x2l, rList=flds_x2l_mod, lsize=lsize) + call mct_aVect_init(x2l, rList=flds_x2l, lsize=lsize) call mct_aVect_zero(x2l) + nxg = SDLND%nxg + nyg = SDLND%nyg + !---------------------------------------------------------------------------- ! Read restart !---------------------------------------------------------------------------- @@ -410,8 +400,7 @@ subroutine dlnd_comp_init(x2l, l2x, & call t_adj_detailf(+2) write_restart = .false. - call dlnd_comp_run(x2l, l2x, & - SDLND, mpicom, my_task, master_task, & + call dlnd_comp_run(mpicom, my_task, master_task, & inst_suffix, logunit, read_restart, write_restart, & current_ymd, current_tod) @@ -427,17 +416,13 @@ end subroutine dlnd_comp_init !=============================================================================== - subroutine dlnd_comp_run(x2l, l2x, & - SDLND, mpicom, my_task, master_task, & + subroutine dlnd_comp_run(mpicom, my_task, master_task, & inst_suffix, logunit, read_restart, write_restart, & target_ymd, target_tod, case_name) ! !DESCRIPTION: run method for dlnd model ! input/output variables: - type(mct_aVect) , intent(inout) :: x2l - type(mct_aVect) , intent(inout) :: l2x - type(shr_strdata_type) , intent(inout) :: SDLND integer , intent(in) :: mpicom ! mpi communicator integer , intent(in) :: my_task ! my task in mpi communicator mpicom integer , intent(in) :: master_task ! task number of master task @@ -538,4 +523,41 @@ subroutine dlnd_comp_run(x2l, l2x, & end subroutine dlnd_comp_run + !=============================================================================== + + subroutine dlnd_comp_export(exportState, rc) + + ! input/output variables + type(ESMF_State) :: exportState + integer, intent(out) :: rc + + ! local variables + integer :: k,n + character(nec_len) :: nec_str ! elevation class, as character string + !---------------------------------------------------------------- + + rc = ESMF_SUCCESS + + k = mct_aVect_indexRA(l2x, "Sl_lfrin") + call dshr_export(l2x%rattr(k,:), exportState, "Sl_lfrin", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + do n = 1,glc_nec + nec_str = glc_elevclass_as_string(n) + + k = mct_aVect_indexRA(l2x, "Sl_tsrf" // nec_str) + call dshr_export(l2x%rattr(k,:), exportState, "Sl_tsrf_elev", ungridded_index=n, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(l2x, "Sl_topo" // nec_str) + call dshr_export(l2x%rattr(k,:), exportState, "Sl_topo_elev", ungridded_index=n, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(l2x, "Flgl_qice" // nec_str) + call dshr_export(l2x%rattr(k,:), exportState, "Flgl_qice_elev", ungridded_index=n, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + end subroutine dlnd_comp_export + end module dlnd_comp_mod diff --git a/src/components/data_comps/dlnd/nuopc/dlnd_shr_mod.F90 b/src/components/data_comps/dlnd/nuopc/dlnd_shr_mod.F90 index 8e55712583e0..175d7e59aa01 100644 --- a/src/components/data_comps/dlnd/nuopc/dlnd_shr_mod.F90 +++ b/src/components/data_comps/dlnd/nuopc/dlnd_shr_mod.F90 @@ -23,6 +23,9 @@ module dlnd_shr_mod ! Public data !-------------------------------------------------------------------------- + ! stream data type + type(shr_strdata_type), public :: SDLND + ! input namelist variables character(CL) , public :: restfilm ! model restart file namelist character(CL) , public :: restfils ! stream restart file namelist @@ -40,7 +43,7 @@ module dlnd_shr_mod !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ subroutine dlnd_shr_read_namelists(filename, mpicom, my_task, master_task, & - logunit, SDLND, lnd_present, lnd_prognostic) + logunit, lnd_present, lnd_prognostic) ! !DESCRIPTION: Read in dlnd namelists implicit none @@ -51,7 +54,6 @@ subroutine dlnd_shr_read_namelists(filename, mpicom, my_task, master_task, & integer(IN) , intent(in) :: my_task ! my task in mpi communicator mpicom integer(IN) , intent(in) :: master_task ! task number of master task integer(IN) , intent(in) :: logunit ! logging unit number - type(shr_strdata_type) , intent(inout) :: SDLND logical , intent(out) :: lnd_present ! flag logical , intent(out) :: lnd_prognostic ! flag diff --git a/src/components/data_comps/dlnd/nuopc/lnd_comp_nuopc.F90 b/src/components/data_comps/dlnd/nuopc/lnd_comp_nuopc.F90 index 00ea9b543071..ba6dedacf0bf 100644 --- a/src/components/data_comps/dlnd/nuopc/lnd_comp_nuopc.F90 +++ b/src/components/data_comps/dlnd/nuopc/lnd_comp_nuopc.F90 @@ -25,15 +25,13 @@ module lnd_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - use shr_nuopc_grid_mod , only : shr_nuopc_grid_ArrayToState - use shr_nuopc_grid_mod , only : shr_nuopc_grid_StateToArray use shr_const_mod , only : SHR_CONST_SPVAL use shr_strdata_mod , only : shr_strdata_type - use dshr_nuopc_mod , only : fld_list_type, fldsMax, fld_list_realize + use dshr_nuopc_mod , only : fld_list_type, fldsMax, dshr_realize use dshr_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, ModelSetMetaData use dlnd_shr_mod , only : dlnd_shr_read_namelists use dlnd_comp_mod , only : dlnd_comp_init, dlnd_comp_run, dlnd_comp_advertise - use mct_mod , only : mct_Avect, mct_Avect_info + use dlnd_comp_mod , only : dlnd_comp_export implicit none private ! except @@ -54,9 +52,6 @@ module lnd_comp_nuopc type (fld_list_type) :: fldsToLnd(fldsMax) type (fld_list_type) :: fldsFrLnd(fldsMax) - type(shr_strdata_type) :: SDLND - type(mct_aVect) :: x2d - type(mct_aVect) :: d2x integer :: compid ! mct comp id integer :: mpicom ! mpi communicator integer :: my_task ! my task in mpi communicator mpicom @@ -67,13 +62,9 @@ module lnd_comp_nuopc integer ,parameter :: master_task=0 ! task number of master task character(CL) :: case_name ! case name logical :: lnd_prognostic ! data is sent back to dlnd - character(CXX) :: flds_l2x = '' - character(CXX) :: flds_x2l = '' character(len=80) :: calendar ! calendar name logical :: use_esmf_metadata = .false. character(*),parameter :: modName = "(lnd_comp_nuopc)" - integer, parameter :: debug_import = 0 ! if > 0 will diagnose import fields - integer, parameter :: debug_export = 0 ! if > 0 will diagnose export fields character(*),parameter :: u_FILE_u = & __FILE__ @@ -85,12 +76,11 @@ subroutine SetServices(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - integer :: dbrc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) @@ -122,7 +112,7 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine SetServices @@ -153,13 +143,12 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(len=CL) :: logfile integer :: glc_nec ! number of elevation classes integer :: localPet - integer :: dbrc character(len=CL) :: fileName ! generic file name character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! generate local mpi comm @@ -193,7 +182,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) filename = "dlnd_in"//trim(inst_suffix) call dlnd_shr_read_namelists(filename, mpicom, my_task, master_task, & - logunit, SDLND, lnd_present, lnd_prognostic) + logunit, lnd_present, lnd_prognostic) !-------------------------------- ! advertise import and export fields @@ -202,14 +191,13 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name='glc_nec', value=cvalue, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) glc_nec - call ESMF_LogWrite('glc_nec = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite('glc_nec = '// trim(cvalue), ESMF_LOGMSG_INFO) call dlnd_comp_advertise(importState, exportState, & lnd_present, lnd_prognostic, glc_nec, & - fldsFrLnd_num, fldsFrLnd, fldsToLnd_num, fldsToLnd, & - flds_l2x, flds_x2l, rc) + fldsFrLnd_num, fldsFrLnd, fldsToLnd_num, fldsToLnd, rc) - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! Reset shr logging to original values @@ -246,12 +234,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) real(R8) :: scmLat = shr_const_SPVAL ! single column lat real(R8) :: scmLon = shr_const_SPVAL ! single column lon logical :: read_restart ! start from restart - integer :: dbrc + integer :: nxg, nyg character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! Reset shr logging to my log file @@ -294,7 +282,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then calendar = shr_cal_gregorian else - call ESMF_LogWrite(subname//" ERROR bad ESMF calendar name "//trim(calendar), ESMF_LOGMSG_ERROR, rc=dbrc) + call ESMF_LogWrite(subname//" ERROR bad ESMF calendar name "//trim(calendar), ESMF_LOGMSG_ERROR) rc = ESMF_Failure return end if @@ -317,10 +305,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Initialize model !---------------------------------------------------------------------------- - call dlnd_comp_init(x2d, d2x, & - SDLND, mpicom, compid, my_task, master_task, & + call dlnd_comp_init(mpicom, compid, my_task, master_task, & inst_suffix, logunit, read_restart, & - scmMode, scmlat, scmlon, calendar, current_ymd, current_tod, Emesh) + scmMode, scmlat, scmlon, calendar, current_ymd, current_tod, Emesh, nxg, nyg) !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -328,7 +315,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! by replacing the advertised fields with the newly created fields of the same name. !-------------------------------- - call fld_list_realize( & + call dshr_realize( & state=ExportState, & fldList=fldsFrLnd, & numflds=fldsFrLnd_num, & @@ -338,30 +325,22 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) mesh=Emesh, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call fld_list_realize( & - state=importState, & - fldList=fldsToLnd, & - numflds=fldsToLnd_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':dlndImport',& - mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! No import send for now - only export snow fields !-------------------------------- ! Pack export state - ! Copy from d2x to exportState + ! Copy from l2x to exportState ! Set the coupling scalars !-------------------------------- - call shr_nuopc_grid_ArrayToState(d2x%rattr, flds_l2x, exportState, grid_option='mesh', rc=rc) + call dlnd_comp_export(exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDLND%nxg),flds_scalar_index_nx, exportState, & + call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDLND%nyg),flds_scalar_index_ny, exportState, & + call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -369,10 +348,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! diagnostics !-------------------------------- - if (debug_export > 0) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif + call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) @@ -382,14 +359,17 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine InitializeRealize !=============================================================================== subroutine ModelAdvance(gcomp, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_memcheck, shr_nuopc_log_clock_advance + + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -407,12 +387,11 @@ subroutine ModelAdvance(gcomp, rc) integer :: yr ! year integer :: mon ! month integer :: day ! day in month - integer :: dbrc character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) call shr_nuopc_memcheck(subname, 5, my_task==master_task) @@ -428,7 +407,7 @@ subroutine ModelAdvance(gcomp, rc) call NUOPC_ModelGet(gcomp, modelClock=clock, importState=importState, exportState=exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (debug_export > 0 .and. my_task == master_task) then + if (my_task == master_task) then call shr_nuopc_methods_Clock_TimePrint(clock,subname//'clock',rc=rc) endif @@ -437,8 +416,9 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- if (lnd_prognostic) then - call shr_nuopc_grid_StateToArray(importState, x2d%rattr, flds_x2l, grid_option='mesh', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! No import state for now - only snow fields + !call dlnd_comp_import(importState, rc=rc) + !if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if !-------------------------------- @@ -469,8 +449,7 @@ subroutine ModelAdvance(gcomp, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yr, mon, day, nextymd) - call dlnd_comp_run(x2d, d2x, & - SDLND, mpicom, my_task, master_task, & + call dlnd_comp_run(mpicom, my_task, master_task, & inst_suffix, logunit, read_restart=.false., write_restart=write_restart, & target_ymd=nextYMD, target_tod=nextTOD, case_name=case_name) @@ -478,21 +457,19 @@ subroutine ModelAdvance(gcomp, rc) ! Pack export state !-------------------------------- - call shr_nuopc_grid_ArrayToState(d2x%rattr, flds_l2x, exportState, grid_option='mesh', rc=rc) + call dlnd_comp_export(exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics !-------------------------------- - if (debug_export > 0) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif + call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return if (my_task == master_task) then call shr_nuopc_log_clock_advance(clock, 'LND', logunit) endif - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) @@ -506,20 +483,19 @@ subroutine ModelFinalize(gcomp, rc) integer, intent(out) :: rc ! local variables - integer :: dbrc character(*), parameter :: F00 = "('(dlnd_comp_final) ',8a)" character(*), parameter :: F91 = "('(dlnd_comp_final) ',73('-'))" character(len=*),parameter :: subname=trim(modName)//':(ModelFinalize) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) if (my_task == master_task) then write(logunit,F91) write(logunit,F00) ' dlnd : end of main integration loop' write(logunit,F91) end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine ModelFinalize diff --git a/src/components/data_comps/docn/nuopc/docn_comp_mod.F90 b/src/components/data_comps/docn/nuopc/docn_comp_mod.F90 index c16e37e706d0..360f09ead97c 100644 --- a/src/components/data_comps/docn/nuopc/docn_comp_mod.F90 +++ b/src/components/data_comps/docn/nuopc/docn_comp_mod.F90 @@ -1,10 +1,10 @@ #ifdef AIX @PROCESS ALIAS_SIZE(805306368) #endif + module docn_comp_mod ! !USES: - use shr_pcdf_mod , only : shr_pcdf_readwrite use NUOPC , only : NUOPC_Advertise use ESMF , only : ESMF_State, ESMF_SUCCESS, ESMF_State use ESMF , only : ESMF_Mesh, ESMF_DistGrid, ESMF_MeshGet, ESMF_DistGridGet @@ -34,12 +34,14 @@ module docn_comp_mod use shr_strdata_mod , only : shr_strdata_print, shr_strdata_restRead use shr_strdata_mod , only : shr_strdata_advance, shr_strdata_restWrite use shr_dmodel_mod , only : shr_dmodel_translateAV - use dshr_nuopc_mod , only : fld_list_type, dshr_fld_add + use shr_pcdf_mod , only : shr_pcdf_readwrite + use dshr_nuopc_mod , only : fld_list_type, dshr_fld_add, dshr_import, dshr_export use docn_shr_mod , only : datamode ! namelist input use docn_shr_mod , only : aquap_option ! derived from datamode namelist input use docn_shr_mod , only : rest_file ! namelist input use docn_shr_mod , only : rest_file_strm ! namelist input use docn_shr_mod , only : nullstr + use docn_shr_mod , only : SDOCN ! !PUBLIC TYPES: implicit none @@ -52,6 +54,8 @@ module docn_comp_mod public :: docn_comp_advertise public :: docn_comp_init public :: docn_comp_run + public :: docn_comp_import + public :: docn_comp_export private :: prescribed_sst @@ -59,6 +63,11 @@ module docn_comp_mod ! Private data !-------------------------------------------------------------------------- + type(mct_aVect) :: x2o + type(mct_aVect) :: o2x + character(CXX) :: flds_o2x = '' + character(CXX) :: flds_x2o = '' + integer :: debug_import = 0 ! debug level (if > 0 will print all import fields) integer :: debug_export = 0 ! debug level (if > 0 will print all export fields) @@ -82,8 +91,6 @@ module docn_comp_mod character(len=CS), pointer :: stifld(:) ! names of fields in input streams character(len=CS), pointer :: stofld(:) ! local names of fields in input streams for calculations character(CXX) :: flds_strm = '' ! set in docn_comp_init - character(len=CXX) :: flds_o2x_mod ! set in docn_comp_advertise - character(len=CXX) :: flds_x2o_mod ! set in docn_comp_advertise logical :: ocn_prognostic_mod ! set in docn_comp_advertise integer , pointer :: imask(:) ! integer ocean mask @@ -101,30 +108,22 @@ module docn_comp_mod !=============================================================================== subroutine docn_comp_advertise(importState, exportState, & - ocn_present, ocn_prognostic, ocnrof_prognostic, & - fldsFrOcn_num, fldsFrOcn, fldsToOcn_num, fldsToOcn, & - flds_o2x, flds_x2o, rc) + ocn_prognostic, fldsFrOcn_num, fldsFrOcn, fldsToOcn_num, fldsToOcn, rc) ! input/output arguments type(ESMF_State) , intent(inout) :: importState type(ESMF_State) , intent(inout) :: exportState - logical , intent(in) :: ocn_present logical , intent(in) :: ocn_prognostic - logical , intent(in) :: ocnrof_prognostic integer , intent(out) :: fldsToOcn_num integer , intent(out) :: fldsFrOcn_num type (fld_list_type) , intent(out) :: fldsToOcn(:) type (fld_list_type) , intent(out) :: fldsFrOcn(:) - character(len=*) , intent(out) :: flds_o2x - character(len=*) , intent(out) :: flds_x2o integer , intent(out) :: rc ! local variables integer :: n !------------------------------------------------------------------------------- - if (.not. ocn_present) return - !-------------------------------- ! export fields !-------------------------------- @@ -136,29 +135,29 @@ subroutine docn_comp_advertise(importState, exportState, & call dshr_fld_add(model_fld='So_omask', model_fld_concat=flds_o2x, model_fld_index=ksomask, & fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) - call dshr_fld_add(model_fld='Fioo_q', model_fld_concat=flds_o2x, model_fld_index=kq, & fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) ! export fields that have a corresponding stream field - call dshr_fld_add(data_fld='t', data_fld_array=avifld, model_fld='So_t', model_fld_array=avofld, & - model_fld_concat=flds_o2x, model_fld_index=kt, fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) - - call dshr_fld_add(data_fld='s', data_fld_array=avifld, model_fld='So_s', model_fld_array=avofld, & - model_fld_concat=flds_o2x, model_fld_index=ks, fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) - - call dshr_fld_add(data_fld='u', data_fld_array=avifld, model_fld='So_u', model_fld_array=avofld, & - model_fld_concat=flds_o2x, model_fld_index=ku, fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) - - call dshr_fld_add(data_fld='v', data_fld_array=avifld, model_fld='So_v', model_fld_array=avofld, & - model_fld_concat=flds_o2x, model_fld_index=kv, fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) - - call dshr_fld_add(data_fld='dhdx', data_fld_array=avifld, model_fld='So_dhdx', model_fld_array=avofld, & - model_fld_concat=flds_o2x, model_fld_index=kdhdx, fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) - - call dshr_fld_add(data_fld='dhdy', data_fld_array=avifld, model_fld='So_dhdy', model_fld_array=avofld, & - model_fld_concat=flds_o2x, model_fld_index=kdhdy, fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) + call dshr_fld_add(data_fld='t', data_fld_array=avifld, & + model_fld='So_t', model_fld_array=avofld, model_fld_concat=flds_o2x, model_fld_index=kt, & + fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) + call dshr_fld_add(data_fld='s', data_fld_array=avifld, & + model_fld='So_s', model_fld_array=avofld, model_fld_concat=flds_o2x, model_fld_index=ks, & + fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) + call dshr_fld_add(data_fld='u', data_fld_array=avifld, & + model_fld='So_u', model_fld_array=avofld, model_fld_concat=flds_o2x, model_fld_index=ku, & + fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) + call dshr_fld_add(data_fld='v', data_fld_array=avifld, & + model_fld='So_v', model_fld_array=avofld, model_fld_concat=flds_o2x, model_fld_index=kv, & + fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) + call dshr_fld_add(data_fld='dhdx', data_fld_array=avifld, & + model_fld='So_dhdx', model_fld_array=avofld, model_fld_concat=flds_o2x, model_fld_index=kdhdx, & + fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) + call dshr_fld_add(data_fld='dhdy', data_fld_array=avifld, & + model_fld='So_dhdy', model_fld_array=avofld, model_fld_concat=flds_o2x, model_fld_index=kdhdy, & + fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) !------------------- ! import fields (have no corresponding stream fields) @@ -185,6 +184,7 @@ subroutine docn_comp_advertise(importState, exportState, & fldlist_num=fldsToOcn_num, fldlist=fldsToOcn) call dshr_fld_add(model_fld='Foxx_rofi', model_fld_concat=flds_x2o, model_fld_index=krofi, & fldlist_num=fldsToOcn_num, fldlist=fldsToOcn) + end if !------------------- @@ -208,11 +208,9 @@ subroutine docn_comp_advertise(importState, exportState, & end if !------------------- - ! Save flds_x2o and flds_o2x as module variables for use in debugging + ! Save as module variables for use in debugging !------------------- - flds_x2o_mod = trim(flds_x2o) - flds_o2x_mod = trim(flds_o2x) ocn_prognostic_mod = ocn_prognostic !------------------- @@ -234,19 +232,15 @@ end subroutine docn_comp_advertise !=============================================================================== - subroutine docn_comp_init(x2o, o2x, & - SDOCN, mpicom, compid, my_task, master_task, & + subroutine docn_comp_init(mpicom, compid, my_task, master_task, & inst_suffix, logunit, read_restart, & - scmMode, scmlat, scmlon, calendar, current_ymd, current_tod, modeldt, mesh) - + scmMode, scmlat, scmlon, calendar, current_ymd, current_tod, modeldt, mesh, nxg, nyg) ! !DESCRIPTION: initialize docn model use pio , only : iosystem_desc_t use shr_pio_mod, only : shr_pio_getiosys, shr_pio_getiotype ! --- input/output arguments --- - type(mct_aVect) , intent(inout) :: x2o, o2x ! input/output attribute vectors - type(shr_strdata_type) , intent(inout) :: SDOCN ! model shr_strdata instance (output) integer , intent(in) :: mpicom ! mpi communicator integer , intent(in) :: compid ! mct comp id integer , intent(in) :: my_task ! my task in mpi communicator mpicom @@ -262,6 +256,7 @@ subroutine docn_comp_init(x2o, o2x, & integer , intent(in) :: current_tod ! model sec into model date integer , intent(in) :: modeldt ! model time step type(ESMF_Mesh) , intent(in) :: mesh ! ESMF docn mesh + integer , intent(out) :: nxg, nyg !--- local variables --- integer :: n,k ! generic counters @@ -424,14 +419,14 @@ subroutine docn_comp_init(x2o, o2x, & call t_startf('docn_initavs') if (my_task == master_task) write(logunit,F00) 'allocate AVs' - call mct_aVect_init(o2x, rList=flds_o2x_mod, lsize=lsize) + call mct_aVect_init(o2x, rList=flds_o2x, lsize=lsize) call mct_aVect_zero(o2x) kfrac = mct_aVect_indexRA(SDOCN%grid%data,'frac') o2x%rAttr(ksomask,:) = SDOCN%grid%data%rAttr(kfrac,:) if (ocn_prognostic_mod) then - call mct_aVect_init(x2o, rList=flds_x2o_mod, lsize=lsize) + call mct_aVect_init(x2o, rList=flds_x2o, lsize=lsize) call mct_aVect_zero(x2o) ! Initialize internal attribute vectors for optional streams @@ -472,6 +467,9 @@ subroutine docn_comp_init(x2o, o2x, & call t_stopf('docn_initavs') + nxg = SDOCN%nxg + nyg = SDOCN%nyg + !---------------------------------------------------------------------------- ! Read restart !---------------------------------------------------------------------------- @@ -535,21 +533,10 @@ subroutine docn_comp_init(x2o, o2x, & call t_adj_detailf(+2) - call docn_comp_run(& - x2o=x2o, & - o2x=o2x, & - SDOCN=SDOCN, & - mpicom=mpicom, & - compid=compid, & - my_task=my_task, & - master_task=master_task, & - inst_suffix=inst_suffix, & - logunit=logunit, & - read_restart=read_restart, & - write_restart=.false., & - target_ymd=current_ymd, & - target_tod=current_tod, & - modeldt=modeldt) + call docn_comp_run(mpicom=mpicom, compid=compid, my_task=my_task, & + master_task=master_task, inst_suffix=inst_suffix, logunit=logunit, & + read_restart=read_restart, write_restart=.false., & + target_ymd=current_ymd, target_tod=current_tod, modeldt=modeldt) if (my_task == master_task) then write(logunit,F00) 'docn_comp_init done' @@ -563,18 +550,13 @@ end subroutine docn_comp_init !=============================================================================== - subroutine docn_comp_run(x2o, o2x, & - SDOCN, mpicom, compid, my_task, master_task, & + subroutine docn_comp_run(mpicom, compid, my_task, master_task, & inst_suffix, logunit, read_restart, write_restart, & target_ymd, target_tod, modeldt, case_name) ! !DESCRIPTION: run method for docn model - implicit none ! !INPUT/OUTPUT PARAMETERS: - type(mct_aVect) , intent(inout) :: x2o - type(mct_aVect) , intent(inout) :: o2x - type(shr_strdata_type) , intent(inout) :: SDOCN integer , intent(in) :: mpicom ! mpi communicator integer , intent(in) :: compid ! mct comp id integer , intent(in) :: my_task ! my task in mpi communicator mpicom @@ -589,21 +571,20 @@ subroutine docn_comp_run(x2o, o2x, & character(len=*) , intent(in), optional :: case_name ! case name !--- local --- - integer :: n,nfld ! indices - integer :: lsize ! size of attr vect - real(R8) :: dt ! timestep - integer :: nu ! unit number - character(len=18) :: date_str - character(len=CS) :: fldname - character(len=CL) :: local_case_name - real(R8), parameter :: & - swp = 0.67_R8*(exp((-1._R8*shr_const_zsrflyr) /1.0_R8)) + 0.33_R8*exp((-1._R8*shr_const_zsrflyr)/17.0_R8) - + integer :: n,nfld ! indices + integer :: lsize ! size of attr vect + real(R8) :: dt ! timestep + integer :: nu ! unit number + character(len=18) :: date_str + character(len=CS) :: fldname + character(len=CL) :: local_case_name character(*), parameter :: F00 = "('(docn_comp_run) ',8a)" character(*), parameter :: F01 = "('(docn_comp_run) ',a, i7,2x,i5,2x,i5,2x,d21.14)" character(*), parameter :: F04 = "('(docn_comp_run) ',2a,2i8,'s')" character(*), parameter :: F0D = "('(docn_comp_run) ',a, i7,2x,i5,2x,i5,2x,d21.14)" character(*), parameter :: subName = "(docn_comp_run) " + real(R8), parameter :: & + swp = 0.67_R8*(exp((-1._R8*shr_const_zsrflyr) /1.0_R8)) + 0.33_R8*exp((-1._R8*shr_const_zsrflyr)/17.0_R8) !------------------------------------------------------------------------------- !-------------------- @@ -612,7 +593,7 @@ subroutine docn_comp_run(x2o, o2x, & if (debug_import > 0 .and. my_task == master_task .and. ocn_prognostic_mod) then do nfld = 1, mct_aVect_nRAttr(x2o) - call shr_string_listGetName(trim(flds_x2o_mod), nfld, fldname) + call shr_string_listGetName(trim(flds_x2o), nfld, fldname) do n = 1, mct_aVect_lsize(x2o) write(logunit,F0D)'import: ymd,tod,n = '// trim(fldname),target_ymd, target_tod, & n, x2o%rattr(nfld,n) @@ -627,6 +608,7 @@ subroutine docn_comp_run(x2o, o2x, & else local_case_name = " " endif + !-------------------- ! ADVANCE OCN !-------------------- @@ -818,7 +800,7 @@ subroutine docn_comp_run(x2o, o2x, & if (debug_export > 1 .and. my_task == master_task) then do nfld = 1, mct_aVect_nRAttr(o2x) - call shr_string_listGetName(trim(flds_o2x_mod), nfld, fldname) + call shr_string_listGetName(trim(flds_o2x), nfld, fldname) do n = 1, mct_aVect_lsize(o2x) write(logunit,F0D)'export: ymd,tod,n = '// trim(fldname),target_ymd, target_tod, & n, o2x%rattr(nfld,n) @@ -870,6 +852,77 @@ end subroutine docn_comp_run !=============================================================================== + subroutine docn_comp_import(importState, rc) + + ! input/output variables + type(ESMF_State) :: importState + integer, intent(out) :: rc + !---------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call dshr_import(importState, 'Foxx_swnet', x2o%rattr(kswnet,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Foxx_lwup', x2o%rattr(klwup,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Foxx_sen', x2o%rattr(ksen,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Foxx_lat', x2o%rattr(klat,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Faxa_lwdn', x2o%rattr(klwdn,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Faxa_snow', x2o%rattr(ksnow,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Fioi_melth', x2o%rattr(kmelth,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine docn_comp_import + + !=============================================================================== + + subroutine docn_comp_export(exportState, rc) + + ! input/output variables + type(ESMF_State) :: exportState + integer, intent(out) :: rc + !---------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call dshr_export(o2x%rattr(ksomask,:), exportState, 'So_omask', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(o2x%rattr(kt,:), exportState, 'So_t', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(o2x%rattr(ks,:), exportState, 'So_s', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(o2x%rattr(ku,:), exportState, 'So_u', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(o2x%rattr(kv,:), exportState, 'So_v', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(o2x%rattr(kdhdx,:), exportState, 'So_dhdx', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(o2x%rattr(kdhdy,:), exportState, 'So_dhdy', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(o2x%rattr(kq,:), exportState, 'Fioo_q', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine docn_comp_export + + !=============================================================================== + subroutine prescribed_sst(xc, yc, lsize, sst_option, sst) real(R8) , intent(in) :: xc(:) !degrees diff --git a/src/components/data_comps/docn/nuopc/docn_shr_mod.F90 b/src/components/data_comps/docn/nuopc/docn_shr_mod.F90 index 36a2d1c52a40..8fdc128fc84c 100644 --- a/src/components/data_comps/docn/nuopc/docn_shr_mod.F90 +++ b/src/components/data_comps/docn/nuopc/docn_shr_mod.F90 @@ -25,6 +25,9 @@ module docn_shr_mod ! Note that model decomp will now come from reading in the mesh directly + ! stream data type + type(shr_strdata_type), public :: SDOCN + ! input namelist variables character(CL) , public :: restfilm ! model restart file namelist character(CL) , public :: restfils ! stream restart file namelist @@ -42,7 +45,7 @@ module docn_shr_mod !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ subroutine docn_shr_read_namelists(filename, mpicom, my_task, master_task, & - logunit, SDOCN, ocn_present, ocn_prognostic, ocnrof_prognostic) + logunit, ocn_prognostic) ! !DESCRIPTION: Read in docn namelists implicit none @@ -53,10 +56,7 @@ subroutine docn_shr_read_namelists(filename, mpicom, my_task, master_task, & integer(IN) , intent(in) :: my_task ! my task in mpi communicator mpicom integer(IN) , intent(in) :: master_task ! task number of master task integer(IN) , intent(in) :: logunit ! logging unit number - type(shr_strdata_type) , intent(inout) :: SDOCN - logical , intent(out) :: ocn_present ! flag logical , intent(out) :: ocn_prognostic ! flag - logical , intent(out) :: ocnrof_prognostic ! flag !--- local variables --- integer(IN) :: nunit ! unit number @@ -148,11 +148,6 @@ subroutine docn_shr_read_namelists(filename, mpicom, my_task, master_task, & ! Determine present and prognostic flag !---------------------------------------------------------------------------- - ocn_present = .true. - if (trim(datamode) == 'NULL') then - ocn_present = .false. - end if - ocn_prognostic = .false. if (force_prognostic_true) then ocn_prognostic = .true. @@ -164,11 +159,6 @@ subroutine docn_shr_read_namelists(filename, mpicom, my_task, master_task, & ocn_prognostic = .true. endif - ocnrof_prognostic = .false. - if (force_prognostic_true .or. (trim(datamode) == 'IAF')) then - ocnrof_prognostic = .true. - end if - end subroutine docn_shr_read_namelists end module docn_shr_mod diff --git a/src/components/data_comps/docn/nuopc/ocn_comp_nuopc.F90 b/src/components/data_comps/docn/nuopc/ocn_comp_nuopc.F90 index 9e25adcdb012..88bb5da6866a 100644 --- a/src/components/data_comps/docn/nuopc/ocn_comp_nuopc.F90 +++ b/src/components/data_comps/docn/nuopc/ocn_comp_nuopc.F90 @@ -12,12 +12,9 @@ module ocn_comp_nuopc use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet - use med_constants_mod , only : R8, I8, CL, CXX - use med_constants_mod , only : shr_log_Unit + use med_constants_mod , only : R8, CL use med_constants_mod , only : shr_cal_ymd2date, shr_cal_noleap, shr_cal_gregorian use med_constants_mod , only : shr_file_getlogunit, shr_file_setlogunit - use med_constants_mod , only : shr_file_getloglevel, shr_file_setloglevel - use med_constants_mod , only : shr_file_setIO, shr_file_getUnit use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_scalars_mod , only : flds_scalar_num use shr_nuopc_scalars_mod , only : flds_scalar_index_nx @@ -26,15 +23,12 @@ module ocn_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - use shr_nuopc_grid_mod , only : shr_nuopc_grid_ArrayToState - use shr_nuopc_grid_mod , only : shr_nuopc_grid_StateToArray use shr_strdata_mod , only : shr_strdata_type - use shr_const_mod , only : SHR_CONST_SPVAL - use dshr_nuopc_mod , only : fld_list_type, fldsMax, fld_list_realize + use dshr_nuopc_mod , only : fld_list_type, fldsMax, dshr_realize use dshr_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, ModelSetMetaData use docn_shr_mod , only : docn_shr_read_namelists use docn_comp_mod , only : docn_comp_init, docn_comp_run, docn_comp_advertise - use mct_mod , only : mct_Avect, mct_Avect_info + use docn_comp_mod , only : docn_comp_import, docn_comp_export implicit none @@ -56,9 +50,6 @@ module ocn_comp_nuopc type (fld_list_type) :: fldsToOcn(fldsMax) type (fld_list_type) :: fldsFrOcn(fldsMax) - type(shr_strdata_type) :: SDOCN - type(mct_aVect) :: x2o - type(mct_aVect) :: o2x integer :: compid ! mct comp id integer :: mpicom ! mpi communicator integer :: my_task ! my task in mpi communicator mpicom @@ -70,9 +61,7 @@ module ocn_comp_nuopc character(CL) :: case_name ! case name character(len=80) :: calendar ! calendar name logical :: ocn_present ! flag - logical :: ocn_prognostic ! flag - character(CXX) :: flds_o2x = '' - character(CXX) :: flds_x2o = '' + logical :: ocn_prognostic ! flag integer :: logunit ! logging unit number logical :: use_esmf_metadata = .false. character(*),parameter :: modName = "(ocn_comp_nuopc)" @@ -91,13 +80,11 @@ subroutine SetServices(gcomp, rc) ! local variables integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - integer :: dbrc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) @@ -132,16 +119,18 @@ subroutine SetServices(gcomp, rc) specRoutine=ModelFinalize, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine SetServices !=============================================================================== subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_set_component_logging use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -149,39 +138,24 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! local variables type(ESMF_VM) :: vm - integer :: lmpicom - character(len=CL) :: cvalue - logical :: activefld - integer :: n,nflds - integer :: ierr ! error code integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - integer :: dbrc - logical :: isPresent - character(len=CL) :: diro - character(len=CL) :: logfile - logical :: ocnrof_prognostic ! flag - integer :: localPet character(len=CL) :: fileName ! generic file name character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- - ! generate local mpi comm + ! get mpi data !---------------------------------------------------------------------------- call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, mpiCommunicator=lmpicom, localPet=localPet, rc=rc) + call ESMF_VMGet(vm, mpiCommunicator=mpicom, localPet=my_task, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call mpi_comm_dup(lmpicom, mpicom, ierr) - call mpi_comm_rank(mpicom, my_task, ierr) - !---------------------------------------------------------------------------- ! determine instance information !---------------------------------------------------------------------------- @@ -193,48 +167,50 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit, shrloglev) + call shr_nuopc_set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit) !---------------------------------------------------------------------------- ! Read input namelists and set present and prognostic flags !---------------------------------------------------------------------------- filename = "docn_in"//trim(inst_suffix) - call docn_shr_read_namelists(filename, mpicom, my_task, master_task, & - logunit, SDOCN, ocn_present, ocn_prognostic, ocnrof_prognostic) + call docn_shr_read_namelists(filename, mpicom, my_task, master_task, logunit, ocn_prognostic) - ! TODO: - hard wire prognostic for now to get atm/ocn flux - ! computation and ocn albedos computed in mediator - ocn_prognostic = .true. + write(6,*)'DEBUG: ocn_prognostic = ',ocn_prognostic !-------------------------------- ! Advertise import and export fields !-------------------------------- call docn_comp_advertise(importstate, exportState, & - ocn_present, ocn_prognostic, ocnrof_prognostic, & - fldsFrOcn_num, fldsFrOcn, fldsToOcn_num, fldsToOcn, & - flds_o2x, flds_x2o, rc) + ocn_prognostic, fldsFrOcn_num, fldsFrOcn, fldsToOcn_num, fldsToOcn, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! Reset shr logging to original values !---------------------------------------------------------------------------- call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine InitializeAdvertise !=============================================================================== subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + + use shr_const_mod, only : shr_const_spval + + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc ! local variables + integer :: n + integer :: nxg, nyg + character(CL) :: cvalue type(ESMF_Mesh) :: Emesh type(ESMF_Time) :: currTime type(ESMF_TimeInterval) :: timeStep @@ -246,28 +222,21 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: current_day ! model day integer :: current_tod ! model sec into model date integer :: modeldt ! model timestep - integer :: n - character(CL) :: cvalue - integer :: ierr ! error code logical :: scmMode = .false. ! single column mode - real(R8) :: scmLat = shr_const_SPVAL ! single column lat - real(R8) :: scmLon = shr_const_SPVAL ! single column lon - integer :: dbrc - integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level + real(R8) :: scmLat = shr_const_spval ! single column lat + real(R8) :: scmLon = shr_const_spval ! single column lon + integer :: shrlogunit ! original log unit character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! Reset shr logging to my log file !---------------------------------------------------------------------------- call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logUnit) !-------------------------------- @@ -314,7 +283,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then calendar = shr_cal_gregorian else - call ESMF_LogWrite(subname//" ERROR bad ESMF calendar name "//trim(calendar), ESMF_LOGMSG_ERROR, rc=dbrc) + call ESMF_LogWrite(subname//" ERROR bad ESMF calendar name "//trim(calendar), ESMF_LOGMSG_ERROR) rc = ESMF_Failure return end if @@ -340,10 +309,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Initialize model !---------------------------------------------------------------------------- - call docn_comp_init(x2o, o2x, & - SDOCN, mpicom, compid, my_task, master_task, & + call docn_comp_init(mpicom, compid, my_task, master_task, & inst_suffix, logunit, read_restart, & - scmMode, scmlat, scmlon, calendar, current_ymd, current_tod, modeldt, Emesh) + scmMode, scmlat, scmlon, calendar, current_ymd, current_tod, modeldt, Emesh, nxg, nyg) !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -351,46 +319,41 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! by replacing the advertised fields with the newly created fields of the same name. !-------------------------------- - if (ocn_present) then - ! export fields - call fld_list_realize( & - state=ExportState, & - fldList=fldsFrOcn, & - numflds=fldsFrOcn_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':docnExport',& - mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - ! import fields - if (ocn_prognostic) then - call fld_list_realize( & - state=importState, & - fldList=fldsToOcn, & - numflds=fldsToOcn_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':docnImport',& - mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end if + ! export fields + call dshr_realize( & + state=ExportState, & + fldList=fldsFrOcn, & + numflds=fldsFrOcn_num, & + flds_scalar_name=flds_scalar_name, & + flds_scalar_num=flds_scalar_num, & + tag=subname//':docnExport',& + mesh=Emesh, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! import fields + call dshr_realize( & + state=importState, & + fldList=fldsToOcn, & + numflds=fldsToOcn_num, & + flds_scalar_name=flds_scalar_name, & + flds_scalar_num=flds_scalar_num, & + tag=subname//':docnImport',& + mesh=Emesh, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Pack export state - ! Copy from o2x to exportState ! Set the coupling scalars !-------------------------------- - call shr_nuopc_grid_ArrayToState(o2x%rattr, flds_o2x, exportState, grid_option='mesh', rc=rc) + call docn_comp_export(exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDOCN%nxg),flds_scalar_index_nx, exportState, & + call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDOCN%nyg),flds_scalar_index_ny, exportState, & + call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -407,7 +370,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Reset shr logging to original values !---------------------------------------------------------------------------- - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) if (use_esmf_metadata) then @@ -415,14 +377,17 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine InitializeRealize !=============================================================================== subroutine ModelAdvance(gcomp, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_memcheck, shr_nuopc_log_clock_advance + + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -443,14 +408,12 @@ subroutine ModelAdvance(gcomp, rc) integer :: mon ! month integer :: day ! day in month integer :: modeldt ! model timestep - integer :: dbrc integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) call shr_nuopc_memcheck(subname, 5, my_task==master_task) @@ -459,8 +422,6 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) !-------------------------------- @@ -479,7 +440,7 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- if (ocn_prognostic) then - call shr_nuopc_grid_StateToArray(importState, x2o%rattr, flds_x2o, grid_option='mesh', rc=rc) + call docn_comp_import(importState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -518,8 +479,7 @@ subroutine ModelAdvance(gcomp, rc) ! Advance the model - call docn_comp_run(x2o, o2x, & - SDOCN, mpicom, compid, my_task, master_task, & + call docn_comp_run(mpicom, compid, my_task, master_task, & inst_suffix, logunit, read_restart, write_restart, & nextYMD, nextTOD, modeldt, case_name=case_name) @@ -527,7 +487,7 @@ subroutine ModelAdvance(gcomp, rc) ! Pack export state !-------------------------------- - call shr_nuopc_grid_ArrayToState(o2x%rattr, flds_o2x, exportState, grid_option='mesh', rc=rc) + call docn_comp_export(exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- @@ -541,9 +501,8 @@ subroutine ModelAdvance(gcomp, rc) if (my_task == master_task) then call shr_nuopc_log_clock_advance(clock, 'OCN', logunit) end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) end subroutine ModelAdvance @@ -551,11 +510,11 @@ end subroutine ModelAdvance !=============================================================================== subroutine ModelFinalize(gcomp, rc) + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc ! local variables - integer :: dbrc character(*), parameter :: F00 = "('(docn_comp_final) ',8a)" character(*), parameter :: F91 = "('(docn_comp_final) ',73('-'))" character(len=*),parameter :: subname=trim(modName)//':(ModelFinalize) ' @@ -567,7 +526,7 @@ subroutine ModelFinalize(gcomp, rc) write(logunit,F00) 'docn : end of main integration loop' write(logunit,F91) end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine ModelFinalize diff --git a/src/components/data_comps/drof/nuopc/drof_comp_mod.F90 b/src/components/data_comps/drof/nuopc/drof_comp_mod.F90 index 375592c0ef42..87c93dc40375 100644 --- a/src/components/data_comps/drof/nuopc/drof_comp_mod.F90 +++ b/src/components/data_comps/drof/nuopc/drof_comp_mod.F90 @@ -29,8 +29,7 @@ module drof_comp_mod use shr_cal_mod , only : shr_cal_datetod2string use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use dshr_nuopc_mod , only : fld_list_type - use dshr_nuopc_mod , only : dshr_fld_add + use dshr_nuopc_mod , only : fld_list_type, dshr_fld_add, dshr_export use drof_shr_mod , only : datamode ! namelist input use drof_shr_mod , only : rest_file ! namelist input use drof_shr_mod , only : rest_file_strm ! namelist input @@ -47,6 +46,7 @@ module drof_comp_mod public :: drof_comp_advertise public :: drof_comp_init public :: drof_comp_run + public :: drof_comp_export !-------------------------------------------------------------------------- ! Private data @@ -495,4 +495,29 @@ subroutine drof_comp_run(x2r, r2x, & end subroutine drof_comp_run + !=============================================================================== + + subroutine drof_comp_export(r2x, exportState, rc) + + ! input/output variables + type(mct_aVect) :: r2x + type(ESMF_State) :: exportState + integer, intent(out) :: rc + + ! local variables + integer :: k + !---------------------------------------------------------------- + + rc = ESMF_SUCCESS + + k = mct_aVect_indexRA(r2x, 'Forr_rofl') + call dshr_export(r2x%rattr(k,:), exportState, 'Forr_rofl', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(r2x, 'Forr_rofi') + call dshr_export(r2x%rattr(k,:), exportState, 'Forr_rofi', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine drof_comp_export + end module drof_comp_mod diff --git a/src/components/data_comps/drof/nuopc/rof_comp_nuopc.F90 b/src/components/data_comps/drof/nuopc/rof_comp_nuopc.F90 index 3afa884d5e2a..7cde9dec63d6 100644 --- a/src/components/data_comps/drof/nuopc/rof_comp_nuopc.F90 +++ b/src/components/data_comps/drof/nuopc/rof_comp_nuopc.F90 @@ -25,15 +25,14 @@ module rof_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - use shr_nuopc_grid_mod , only : shr_nuopc_grid_ArrayToState - use shr_nuopc_grid_mod , only : shr_nuopc_grid_StateToArray use shr_const_mod , only : SHR_CONST_SPVAL use shr_strdata_mod , only : shr_strdata_type - use dshr_nuopc_mod , only : fld_list_type, fldsMax, fld_list_realize + use dshr_nuopc_mod , only : fld_list_type, fldsMax, dshr_realize use dshr_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, ModelSetMetaData use drof_shr_mod , only : drof_shr_read_namelists use drof_comp_mod , only : drof_comp_init, drof_comp_run, drof_comp_advertise - use mct_mod , only : mct_Avect, mct_Avect_info + use drof_comp_mod , only : drof_comp_export + use mct_mod , only : mct_Avect implicit none private ! except @@ -129,8 +128,11 @@ end subroutine SetServices !=============================================================================== subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_set_component_logging use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance + + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -319,7 +321,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! by replacing the advertised fields with the newly created fields of the same name. !-------------------------------- - call fld_list_realize( & + call dshr_realize( & state=ExportState, & fldList=fldsFrRof, & numflds=fldsFrRof_num, & @@ -329,7 +331,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) mesh=Emesh, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! Todo: no import state for now - should this be added? + ! No import state for now !-------------------------------- ! Pack export state @@ -337,7 +339,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Set the coupling scalars !-------------------------------- - call shr_nuopc_grid_ArrayToState(r2x%rattr, flds_r2x, exportState, 'mesh', rc=rc) + call drof_comp_export(r2x, exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(SDROF%nxg),flds_scalar_index_nx, exportState, & @@ -429,8 +431,7 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- if (rof_prognostic) then - call shr_nuopc_grid_StateToArray(importState, x2r%rattr, flds_x2r, 'mesh', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! Do nothing for now end if !-------------------------------- @@ -475,7 +476,7 @@ subroutine ModelAdvance(gcomp, rc) ! Pack export state !-------------------------------- - call shr_nuopc_grid_ArrayToState(r2x%rattr, flds_r2x, exportState, 'mesh', rc=rc) + call drof_comp_export(r2x, exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- diff --git a/src/components/data_comps/dshr_nuopc/dshr_nuopc_mod.F90 b/src/components/data_comps/dshr_nuopc/dshr_nuopc_mod.F90 index 9ad306c375b6..9e6a85019bab 100644 --- a/src/components/data_comps/dshr_nuopc/dshr_nuopc_mod.F90 +++ b/src/components/data_comps/dshr_nuopc/dshr_nuopc_mod.F90 @@ -1,32 +1,38 @@ module dshr_nuopc_mod - use ESMF use NUOPC - use NUOPC_Model , only : NUOPC_ModelGet + use NUOPC_Model + use ESMF use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use shr_nuopc_time_mod , only : shr_nuopc_time_alarmInit - use shr_kind_mod , only : R8=>SHR_KIND_R8, CS=>SHR_KIND_CS + use shr_kind_mod , only : r8=>shr_kind_r8, cs=>shr_kind_cs, cxx=>shr_kind_cxx + use shr_string_mod , only : shr_string_listGetIndex use shr_sys_mod , only : shr_sys_abort implicit none public public :: dshr_fld_add - public :: fld_list_add ! TODO: remove - public :: fld_list_realize ! TODO: rename to dshr_realize + public :: dshr_import + public :: dshr_export + public :: dshr_realize public :: ModelInitPhase ! TODO: rename to dshr_modelinit public :: ModelSetRunClock ! TODO: rename to dshr_setrunclock public :: ModelSetMetaData ! TODO rename to dshr_setmetadata type fld_list_type character(len=128) :: stdname + integer :: ungridded_lbound = 0 + integer :: ungridded_ubound = 0 end type fld_list_type interface dshr_fld_add ; module procedure & + dshr_fld_add, & dshr_fld_add_model, & dshr_fld_add_model_and_data end interface dshr_fld_add + integer :: gridTofieldMap = 2 ! ungridded dimension is innermost integer , parameter :: fldsMax = 100 integer , parameter :: dbug = 10 character(*), parameter :: modName = "(dhsr_nuopc_mod)" @@ -37,36 +43,49 @@ module dshr_nuopc_mod contains !=============================================================================== - subroutine dshr_fld_add_model(model_fld, model_fld_concat, model_fld_index, & - fldlist_num, fldlist) + subroutine dshr_fld_add(med_fld, fldlist_num, fldlist, ungridded_lbound, ungridded_ubound) + + ! input/output variables + character(len=*) , intent(in) :: med_fld + integer , intent(inout) :: fldlist_num + type(fld_list_type) , intent(inout) :: fldlist(:) + integer , optional , intent(in) :: ungridded_lbound + integer , optional , intent(in) :: ungridded_ubound + + ! local variables + integer :: rc + character(len=*), parameter :: subname='(dshr_nuopc_mod:dshr_fld_add)' + ! ---------------------------------------------- - use shr_string_mod, only : shr_string_listGetIndex + call dshr_fld_list_add(fldlist_num, fldlist, med_fld, ungridded_lbound, ungridded_ubound) + + end subroutine dshr_fld_add + +!=============================================================================== + + subroutine dshr_fld_add_model(model_fld, model_fld_concat, model_fld_index, & + fldlist_num, fldlist, ungridded_lbound, ungridded_ubound) ! input/output variables - character(len=*) , intent(in) :: model_fld - character(len=*) , intent(inout) :: model_fld_concat - integer, optional , intent(out) :: model_fld_index - integer , intent(inout) :: fldlist_num - type(fld_list_type) , intent(inout) :: fldlist(:) + character(len=*) , intent(in) :: model_fld + character(len=*) , intent(inout) :: model_fld_concat + integer , optional , intent(out) :: model_fld_index + integer , optional , intent(inout) :: fldlist_num + type(fld_list_type) , optional , intent(inout) :: fldlist(:) + integer , optional , intent(in) :: ungridded_lbound + integer , optional , intent(in) :: ungridded_ubound ! local variables integer :: rc - integer :: dbrc character(len=*), parameter :: subname='(dshr_nuopc_mod:dshr_fld_add_model)' ! ---------------------------------------------- - fldlist_num = fldlist_num + 1 - if (fldlist_num > fldsMax) then - call ESMF_LogWrite(trim(subname)//": ERROR fldlist_num > fldsMax "//trim(model_fld), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - return - endif - fldlist(fldlist_num)%stdname = trim(model_fld) - if (len_trim(model_fld_concat) + len_trim(model_fld) + 1 >= len(model_fld_concat)) then - call ESMF_LogWrite(subname//': ERROR: max len of model_fld_concat has been exceeded', & - ESMF_LOGMSG_ERROR, line=__LINE__, file= u_FILE_u, rc=dbrc) + call ESMF_LogWrite(subname//': ERROR: max len of model_fld_concat has been exceeded', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return end if + if (trim(model_fld_concat) == '') then model_fld_concat = trim(model_fld) else @@ -77,29 +96,36 @@ subroutine dshr_fld_add_model(model_fld, model_fld_concat, model_fld_index, & call shr_string_listGetIndex(trim(model_fld_concat), trim(model_fld), model_fld_index) end if + !---------------------------------- + ! Update fldlist array if appropriate + !---------------------------------- + + if (present(fldlist_num) .and. present(fldlist)) then + call dshr_fld_list_add(fldlist_num, fldlist, model_fld, ungridded_lbound, ungridded_ubound) + end if + end subroutine dshr_fld_add_model !=============================================================================== subroutine dshr_fld_add_model_and_data( data_fld, data_fld_array, & model_fld, model_fld_array, model_fld_concat, model_fld_index, & - fldlist_num, fldlist) - - use shr_string_mod, only : shr_string_listGetIndex - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR + fldlist_num, fldlist, ungridded_lbound, ungridded_ubound) ! input/output variables - character(len=*) , intent(in) :: data_fld - character(len=*) , pointer :: data_fld_array(:) - character(len=*) , intent(in) :: model_fld - character(len=*) , pointer :: model_fld_array(:) - character(len=*) , intent(inout) , optional :: model_fld_concat - integer , intent(out) , optional :: model_fld_index - integer , intent(inout) , optional :: fldlist_num - type(fld_list_type), intent(inout) , optional :: fldlist(:) + character(len=*) , intent(in) :: data_fld + character(len=*) , pointer :: data_fld_array(:) + character(len=*) , intent(in) :: model_fld + character(len=*) , pointer :: model_fld_array(:) + character(len=*) , optional , intent(inout) :: model_fld_concat + integer , optional , intent(out) :: model_fld_index + integer , optional , intent(inout) :: fldlist_num + type(fld_list_type) , optional , intent(inout) :: fldlist(:) + integer , optional , intent(in) :: ungridded_lbound + integer , optional , intent(in) :: ungridded_ubound ! local variables - integer :: dbrc + integer :: rc integer :: n, oldsize, id character(len=CS), pointer :: new_data_fld_array(:) character(len=CS), pointer :: new_model_fld_array(:) @@ -108,6 +134,8 @@ subroutine dshr_fld_add_model_and_data( data_fld, data_fld_array, & !---------------------------------- ! Create new data_fld_array and model_fld_array + ! Model is what the data model sends and receives from the mediator + ! Data is what the data model obtains from the various streams !---------------------------------- ! 1) determine new index @@ -148,9 +176,8 @@ subroutine dshr_fld_add_model_and_data( data_fld, data_fld_array, & !---------------------------------- if (present(model_fld_concat)) then - if (len_trim(model_fld_concat) + len_trim(model_fld) + 1 >= len(model_fld_concat)) then - call ESMF_LogWrite(subname//': ERROR: max len of model_fld_concat has been exceeded', & - ESMF_LOGMSG_ERROR, line=__LINE__, file= u_FILE_u, rc=dbrc) + if (len_trim(model_fld_concat) + len_trim(model_fld) + 1 >= cxx) then + call ESMF_LogWrite(subname//': ERROR: max len of model_fld_concat has been exceeded', ESMF_LOGMSG_INFO) call shr_sys_abort() end if if (trim(model_fld_concat) == '') then @@ -168,33 +195,25 @@ subroutine dshr_fld_add_model_and_data( data_fld, data_fld_array, & !---------------------------------- ! Update fldlist array if appropriate !---------------------------------- - if (present(fldlist_num) .and. present(fldlist)) then - fldlist_num = fldlist_num + 1 - if (fldlist_num > fldsMax) then - call ESMF_LogWrite(trim(subname)//": ERROR fldlist_num > fldsMax "//trim(model_fld), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - return - endif - fldlist(fldlist_num)%stdname = trim(model_fld) + call dshr_fld_list_add(fldlist_num, fldlist, model_fld, ungridded_lbound, ungridded_ubound) end if end subroutine dshr_fld_add_model_and_data !=============================================================================== - subroutine fld_list_add(num, fldlist, stdname, flds_concat) - use ESMF, only : ESMF_LogWrite, ESMF_LOGMSG_ERROR + subroutine dshr_fld_list_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound) ! input/output variables integer, intent(inout) :: num type(fld_list_type), intent(inout) :: fldlist(:) character(len=*), intent(in) :: stdname - character(len=*), optional, intent(inout) :: flds_concat + integer, optional, intent(in) :: ungridded_lbound + integer, optional, intent(in) :: ungridded_ubound ! local variables integer :: rc - integer :: dbrc character(len=*), parameter :: subname='(dshr_nuopc_mod:fld_list_add)' !---------------------------------------------------------------------- @@ -202,36 +221,24 @@ subroutine fld_list_add(num, fldlist, stdname, flds_concat) 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) + call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE return endif fldlist(num)%stdname = trim(stdname) - if (present(flds_concat)) then - if (len_trim(flds_concat) + len_trim(stdname) + 1 >= len(flds_concat)) then - call ESMF_LogWrite(subname//': ERROR: max len of flds_concat has been exceeded', & - ESMF_LOGMSG_ERROR, line=__LINE__, file= u_FILE_u, rc=dbrc) - end if - if (trim(flds_concat) == '') then - flds_concat = trim(stdname) - else - flds_concat = trim(flds_concat)//':'//trim(stdname) - end if + if (present(ungridded_lbound) .and. present(ungridded_ubound)) then + fldlist(num)%ungridded_lbound = ungridded_lbound + fldlist(num)%ungridded_ubound = ungridded_ubound end if - end subroutine fld_list_add + end subroutine dshr_fld_list_add !=============================================================================== - subroutine fld_list_realize(state, fldList, numflds, flds_scalar_name, flds_scalar_num, mesh, tag, rc) - - use NUOPC , only : NUOPC_IsConnected, NUOPC_Realize - use ESMF , only : ESMF_MeshLoc_Element, ESMF_FieldCreate, ESMF_TYPEKIND_R8 - use ESMF , only : ESMF_MAXSTR, ESMF_Field, ESMF_State, ESMF_Mesh, ESMF_StateRemove - use ESMF , only : ESMF_LogFoundError, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LOGERR_PASSTHRU + subroutine dshr_realize(state, fldList, numflds, flds_scalar_name, flds_scalar_num, mesh, tag, rc) + ! input/output variables type(ESMF_State) , intent(inout) :: state type(fld_list_type) , intent(in) :: fldList(:) integer , intent(in) :: numflds @@ -242,7 +249,6 @@ subroutine fld_list_realize(state, fldList, numflds, flds_scalar_name, flds_scal integer , intent(inout) :: rc ! local variables - integer :: dbrc integer :: n type(ESMF_Field) :: field character(len=80) :: stdname @@ -256,16 +262,23 @@ subroutine fld_list_realize(state, fldList, numflds, flds_scalar_name, flds_scal if (NUOPC_IsConnected(state, fieldName=stdname)) then if (stdname == trim(flds_scalar_name)) then call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected on root pe", & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) ! Create the scalar field call SetScalarField(field, flds_scalar_name, flds_scalar_num, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return else - call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected using mesh", & - ESMF_LOGMSG_INFO, rc=dbrc) ! Create the field - field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (fldlist(n)%ungridded_lbound > 0 .and. fldlist(n)%ungridded_ubound > 0) then + field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, & + ungriddedLbound=(/fldlist(n)%ungridded_lbound/), & + ungriddedUbound=(/fldlist(n)%ungridded_ubound/), gridToFieldMap=(/gridToFieldMap/), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else + field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + end if + call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected using mesh", & + ESMF_LOGMSG_INFO) endif ! NOW call NUOPC_Realize @@ -274,7 +287,7 @@ subroutine fld_list_realize(state, fldList, numflds, flds_scalar_name, flds_scal else if (stdname /= trim(flds_scalar_name)) then call ESMF_LogWrite(subname // trim(tag) // " Field = "// trim(stdname) // " is not connected.", & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) call ESMF_StateRemove(state, (/stdname/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return end if @@ -287,9 +300,6 @@ subroutine SetScalarField(field, flds_scalar_name, flds_scalar_num, rc) ! ---------------------------------------------- ! create a field with scalar data on the root pe ! ---------------------------------------------- - use ESMF, only : ESMF_Field, ESMF_DistGrid, ESMF_Grid - use ESMF, only : ESMF_DistGridCreate, ESMF_GridCreate, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU - use ESMF, only : ESMF_FieldCreate, ESMF_GridCreate, ESMF_TYPEKIND_R8 type(ESMF_Field) , intent(inout) :: field character(len=*) , intent(in) :: flds_scalar_name @@ -317,11 +327,13 @@ subroutine SetScalarField(field, flds_scalar_name, flds_scalar_num, rc) end subroutine SetScalarField - end subroutine fld_list_realize + end subroutine dshr_realize !=============================================================================== subroutine ModelInitPhase(gcomp, importState, exportState, clock, rc) + + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -339,6 +351,8 @@ end subroutine ModelInitPhase !=============================================================================== subroutine ModelSetRunClock(gcomp, rc) + + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -352,14 +366,13 @@ subroutine ModelSetRunClock(gcomp, rc) integer :: restart_n ! Number until restart interval integer :: restart_ymd ! Restart date (YYYYMMDD) type(ESMF_ALARM) :: restart_alarm - integer :: dbrc character(len=128) :: name integer :: alarmcount character(len=*),parameter :: subname='dshr_nuopc_mod:(ModelSetRunClock) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! query the Component for its clocks call NUOPC_ModelGet(gcomp, driverClock=dclock, modelClock=mclock, rc=rc) @@ -390,7 +403,7 @@ subroutine ModelSetRunClock(gcomp, rc) call ESMF_GridCompGet(gcomp, name=name, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//'setting alarms for' // trim(name), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//'setting alarms for' // trim(name), ESMF_LOGMSG_INFO) call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -425,7 +438,7 @@ subroutine ModelSetRunClock(gcomp, rc) call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine ModelSetRunClock @@ -485,4 +498,110 @@ subroutine ModelSetMetadata(gcomp, name, rc) end subroutine ModelSetMetadata + !----------------------------------------------------------------------------- + + subroutine dshr_export(array, state, fldname, ungridded_index, rc) + + ! ---------------------------------- + ! copy array data to state fields + ! ---------------------------------- + + ! input/otuput variables + real(r8) , intent(inout) :: array(:) + type(ESMF_State) , intent(inout) :: state + character(len=*) , intent(in) :: fldname + integer, optional, intent(in) :: ungridded_index + integer , intent(out) :: rc + + ! local variables + integer :: lsize, n + type(ESMF_Field) :: lfield + real(R8), pointer :: farray1d(:) + real(R8), pointer :: farray2d(:,:) + character(*),parameter :: subName = "(dshr_nuopc_mod: dshr_export)" + !---------------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(state, itemName=trim(fldname), field=lfield, rc=rc) + if (.not. shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) then + call ESMF_LogWrite(trim(subname)//": fldname = "//trim(fldname)//" copy", ESMF_LOGMSG_INFO) + + lsize = size(array) + if (present(ungridded_index)) then + call ESMF_FieldGet(lfield, farrayPtr=farray2d, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (gridToFieldMap == 1) then + do n = 1,lsize + farray2d(n,ungridded_index) = array(n) + enddo + else if (gridToFieldMap == 2) then + do n = 1,lsize + farray2d(ungridded_index,n) = array(n) + end do + end if + else + call ESMF_FieldGet(lfield, farrayPtr=farray1d, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,lsize + farray1d(n) = array(n) + enddo + end if + end if + + end subroutine dshr_export + + !----------------------------------------------------------------------------- + + subroutine dshr_import(state, fldname, array, ungridded_index, rc) + + ! ---------------------------------- + ! copy state field to array data + ! ---------------------------------- + + ! input/output variables + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fldname + real(r8) , intent(inout) :: array(:) + integer, optional , intent(in) :: ungridded_index + integer , intent(out) :: rc + + ! local variables + integer :: lsize, n + type(ESMF_Field) :: lfield + real(R8), pointer :: farray1d(:) + real(R8), pointer :: farray2d(:,:) + character(*),parameter :: subName = "(dshr_nuopc_mod: dshr_import)" + !---------------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(state, itemName=trim(fldname), field=lfield, rc=rc) + if (.not. shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) then + call ESMF_LogWrite(trim(subname)//": fldname = "//trim(fldname)//" copy", ESMF_LOGMSG_INFO) + + lsize = size(array) + if (present(ungridded_index)) then + call ESMF_FieldGet(lfield, farrayPtr=farray2d, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (gridToFieldMap == 1) then + do n = 1,lsize + array(n) = farray2d(n,ungridded_index) + enddo + else if (gridToFieldMap == 2) then + do n = 1,lsize + array(n) = farray2d(ungridded_index,n) + enddo + end if + else + call ESMF_FieldGet(lfield, farrayPtr=farray1d, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,lsize + array(n) = farray1d(n) + enddo + end if + end if + + end subroutine dshr_import + end module dshr_nuopc_mod diff --git a/src/components/data_comps/dwav/nuopc/dwav_comp_mod.F90 b/src/components/data_comps/dwav/nuopc/dwav_comp_mod.F90 index 2017ebc18b28..1de4a2a7bd5d 100644 --- a/src/components/data_comps/dwav/nuopc/dwav_comp_mod.F90 +++ b/src/components/data_comps/dwav/nuopc/dwav_comp_mod.F90 @@ -30,12 +30,12 @@ module dwav_comp_mod use shr_cal_mod , only : shr_cal_datetod2string use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use dshr_nuopc_mod , only : fld_list_type - use dshr_nuopc_mod , only : dshr_fld_add + use dshr_nuopc_mod , only : fld_list_type, dshr_fld_add, dshr_export use dwav_shr_mod , only : datamode ! namelist input use dwav_shr_mod , only : rest_file ! namelist input use dwav_shr_mod , only : rest_file_strm ! namelist input use dwav_shr_mod , only : nullstr + use dwav_shr_mod , only : SDWAV ! !PUBLIC TYPES: implicit none @@ -48,16 +48,18 @@ module dwav_comp_mod public :: dwav_comp_advertise public :: dwav_comp_init public :: dwav_comp_run - public :: dwav_comp_final + public :: dwav_comp_export !-------------------------------------------------------------------------- ! Private data !-------------------------------------------------------------------------- + type(mct_aVect) :: x2w + type(mct_aVect) :: w2x character(len=CS), pointer :: avifld(:) ! character array for field names coming from streams character(len=CS), pointer :: avofld(:) ! character array for field names to be sent/received from mediator - character(len=CXX) :: flds_w2x_mod - character(len=CXX) :: flds_x2w_mod + character(CXX) :: flds_w2x = '' + character(CXX) :: flds_x2w = '' character(len=*), parameter :: rpfile = 'rpointer.wav' character(*) , parameter :: u_FILE_u = & __FILE__ @@ -68,8 +70,7 @@ module dwav_comp_mod subroutine dwav_comp_advertise(importState, exportState, & wav_present, wav_prognostic, & - fldsFrWav_num, fldsFrWav, fldsToWav_num, fldsToWav, & - flds_w2x, flds_x2w, rc) + fldsFrWav_num, fldsFrWav, fldsToWav_num, fldsToWav, rc) ! 1. determine export and import fields to advertise to mediator ! 2. determine translation of fields from streams to export/import fields @@ -83,8 +84,6 @@ subroutine dwav_comp_advertise(importState, exportState, & type (fld_list_type) , intent(out) :: fldsFrWav(:) integer , intent(out) :: fldsToWav_num type (fld_list_type) , intent(out) :: fldsToWav(:) - character(len=*) , intent(out) :: flds_w2x - character(len=*) , intent(out) :: flds_x2w integer , intent(out) :: rc ! local variables @@ -124,27 +123,17 @@ subroutine dwav_comp_advertise(importState, exportState, & if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return enddo - !------------------- - ! Save flds_w2x and flds_x2w as module variables for use in debugging - !------------------- - - flds_x2w_mod = trim(flds_x2w) - flds_w2x_mod = trim(flds_w2x) - end subroutine dwav_comp_advertise !=============================================================================== - subroutine dwav_comp_init(x2w, w2x, & - SDWAV, mpicom, compid, my_task, master_task, & + subroutine dwav_comp_init(mpicom, compid, my_task, master_task, & inst_suffix, logunit, read_restart, & - target_ymd, target_tod, calendar, mesh) + target_ymd, target_tod, calendar, mesh, nxg, nyg) ! !DESCRIPTION: initialize dwav model ! !INPUT/OUTPUT PARAMETERS: - type(mct_aVect) , intent(inout) :: x2w, w2x ! input/output attribute vectors - type(shr_strdata_type) , intent(inout) :: SDWAV ! model integer , intent(in) :: mpicom ! mpi communicator integer , intent(in) :: compid ! mct comp id integer , intent(in) :: my_task ! my task in mpi communicator mpicom @@ -156,6 +145,7 @@ subroutine dwav_comp_init(x2w, w2x, & integer , intent(in) :: target_tod ! model sec into model date character(len=*) , intent(in) :: calendar ! calendar type type(ESMF_Mesh) , intent(in) :: mesh ! ESMF docn mesh + integer , intent(out) :: nxg, nyg !--- local variables --- integer :: n,k ! generic counters @@ -309,7 +299,7 @@ subroutine dwav_comp_init(x2w, w2x, & deallocate(domlon, domlat) !---------------------------------------------------------------------------- - ! Initialize SDLND attributes for streams and mapping of streams to model domain + ! Initialize SDWAV attributes for streams and mapping of streams to model domain !---------------------------------------------------------------------------- call shr_strdata_init_streams(SDWAV, compid, mpicom, my_task) @@ -323,10 +313,15 @@ subroutine dwav_comp_init(x2w, w2x, & if (my_task == master_task) write(logunit,F00) 'allocate AVs' - call mct_avect_init(w2x, rlist=flds_w2x_mod, lsize=lsize) + call mct_avect_init(w2x, rlist=flds_w2x, lsize=lsize) call mct_avect_zero(w2x) - call mct_avect_init(x2w, rlist=flds_x2w_mod, lsize=lsize) - call mct_avect_zero(x2w) + + ! no import state for now + ! call mct_avect_init(x2w, rlist=flds_x2w, lsize=lsize) + ! call mct_avect_zero(x2w) + + nxg = SDWAV%nxg + nyg = SDWAV%nyg !---------------------------------------------------------------------------- ! Read restart @@ -372,8 +367,7 @@ subroutine dwav_comp_init(x2w, w2x, & !---------------------------------------------------------------------------- write_restart = .false. - call dwav_comp_run(x2w, w2x, & - SDWAV, mpicom, my_task, master_task, & + call dwav_comp_run(mpicom, my_task, master_task, & inst_suffix, logunit, read_restart, write_restart, & target_ymd, target_tod) @@ -387,17 +381,13 @@ end subroutine dwav_comp_init !=============================================================================== - subroutine dwav_comp_run(x2w, w2x, & - SDWAV, mpicom, my_task, master_task, & + subroutine dwav_comp_run(mpicom, my_task, master_task, & inst_suffix, logunit, read_restart, write_restart, & target_ymd, target_tod, case_name) ! DESCRIPTION: run method for dwav model ! input/output parameters: - type(mct_aVect) , intent(inout) :: x2w - type(mct_aVect) , intent(inout) :: w2x - type(shr_strdata_type) , intent(inout) :: SDWAV integer , intent(in) :: mpicom ! mpi communicator integer , intent(in) :: my_task ! my task in mpi communicator mpicom integer , intent(in) :: master_task ! task number of master task @@ -498,27 +488,30 @@ end subroutine dwav_comp_run !=============================================================================== - subroutine dwav_comp_final(my_task, master_task, logunit) + subroutine dwav_comp_export(exportState, rc) - ! !DESCRIPTION: finalize method for dwav model + ! input/output variables + type(ESMF_State) :: exportState + integer, intent(out) :: rc - ! !INPUT/OUTPUT PARAMETERS: - integer , intent(in) :: my_task ! my task in mpi communicator mpicom - integer , intent(in) :: master_task ! task number of master task - integer , intent(in) :: logunit ! logging unit number - - !--- formats --- - character(*), parameter :: F00 = "('(dwav_comp_final) ',8a)" - character(*), parameter :: F91 = "('(dwav_comp_final) ',73('-'))" - character(*), parameter :: subName = "(dwav_comp_final) " - !------------------------------------------------------------------------------- + ! local variables + integer :: k + !---------------------------------------------------------------- - if (my_task == master_task) then - write(logunit,F91) - write(logunit,F00) 'dwav: end of main integration loop' - write(logunit,F91) - end if + rc = ESMF_SUCCESS + + k = mct_aVect_indexRA(w2x, "Sw_lamult") + call dshr_export(w2x%rattr(k,:), exportState, "Sw_lamult", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(w2x, "Sw_ustokes") + call dshr_export(w2x%rattr(k,:), exportState, "Sw_ustokes", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(w2x, "Sw_vstokes") + call dshr_export(w2x%rattr(k,:), exportState, "Sw_vstokes", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end subroutine dwav_comp_final + end subroutine dwav_comp_export end module dwav_comp_mod diff --git a/src/components/data_comps/dwav/nuopc/dwav_shr_mod.F90 b/src/components/data_comps/dwav/nuopc/dwav_shr_mod.F90 index 61814664eba8..8723b99d98c7 100644 --- a/src/components/data_comps/dwav/nuopc/dwav_shr_mod.F90 +++ b/src/components/data_comps/dwav/nuopc/dwav_shr_mod.F90 @@ -23,6 +23,9 @@ module dwav_shr_mod ! Public data !-------------------------------------------------------------------------- + ! stream data type + type(shr_strdata_type), public :: SDWAV + ! input namelist variables character(CL) , public :: restfilm ! model restart file namelist character(CL) , public :: restfils ! stream restart file namelist @@ -39,7 +42,7 @@ module dwav_shr_mod !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ subroutine dwav_shr_read_namelists(filename, mpicom, my_task, master_task, & - logunit, SDWAV, wav_present, wav_prognostic) + logunit, wav_present, wav_prognostic) ! !DESCRIPTION: Read in dwav namelists implicit none @@ -50,7 +53,6 @@ subroutine dwav_shr_read_namelists(filename, mpicom, my_task, master_task, & integer(IN) , intent(in) :: my_task ! my task in mpi communicator mpicom integer(IN) , intent(in) :: master_task ! task number of master task integer(IN) , intent(in) :: logunit ! logging unit number - type(shr_strdata_type) , intent(inout) :: SDWAV logical , intent(out) :: wav_present ! flag logical , intent(out) :: wav_prognostic ! flag @@ -105,7 +107,7 @@ subroutine dwav_shr_read_namelists(filename, mpicom, my_task, master_task, & ! Read dshr namelist !---------------------------------------------------------------------------- - call shr_strdata_readnml(SDWAV,trim(filename),mpicom=mpicom) + call shr_strdata_readnml(SDWAV, trim(filename), mpicom=mpicom) !---------------------------------------------------------------------------- ! Determine and validate datamode diff --git a/src/components/data_comps/dwav/nuopc/wav_comp_nuopc.F90 b/src/components/data_comps/dwav/nuopc/wav_comp_nuopc.F90 index 24e0600de0f9..b910b9cd43fd 100644 --- a/src/components/data_comps/dwav/nuopc/wav_comp_nuopc.F90 +++ b/src/components/data_comps/dwav/nuopc/wav_comp_nuopc.F90 @@ -23,17 +23,16 @@ module wav_comp_nuopc use shr_nuopc_scalars_mod , only : flds_scalar_index_ny use shr_nuopc_methods_mod , only : shr_nuopc_methods_Clock_TimePrint use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_diagnose use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar - use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - use shr_nuopc_grid_mod , only : shr_nuopc_grid_ArrayToState - use shr_nuopc_grid_mod , only : shr_nuopc_grid_StateToArray use shr_const_mod , only : SHR_CONST_SPVAL use shr_strdata_mod , only : shr_strdata_type - use dshr_nuopc_mod , only : fld_list_type, fldsMax, fld_list_realize + use dshr_nuopc_mod , only : fld_list_type, fldsMax, dshr_realize use dshr_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, ModelSetMetaData use dwav_shr_mod , only : dwav_shr_read_namelists use dwav_comp_mod , only : dwav_comp_init, dwav_comp_run, dwav_comp_advertise - use mct_mod + use dwav_comp_mod , only : dwav_comp_export + implicit none private ! except @@ -53,9 +52,7 @@ module wav_comp_nuopc integer :: fldsFrWav_num = 0 type (fld_list_type) :: fldsToWav(fldsMax) type (fld_list_type) :: fldsFrWav(fldsMax) - type(shr_strdata_type) :: SDWAV - type(mct_aVect) :: x2w - type(mct_aVect) :: w2x + integer :: compid ! mct comp id integer :: mpicom ! mpi communicator integer :: my_task ! my task in mpi communicator mpicom @@ -65,13 +62,9 @@ module wav_comp_nuopc logical :: read_restart ! start from restart character(len=256) :: case_name ! case name character(len=80) :: calendar ! calendar name - character(CXX) :: flds_w2x = '' - character(CXX) :: flds_x2w = '' - logical :: wav_prognostic ! flag + logical :: wav_prognostic ! flag logical :: use_esmf_metadata = .false. character(*), parameter :: modName = "(wav_comp_nuopc)" - integer, parameter :: debug_import = 0 ! if > 0 will diagnose import fields - integer, parameter :: debug_export = 0 ! if > 0 will diagnose export fields character(*), parameter :: u_FILE_u = & __FILE__ @@ -83,12 +76,11 @@ subroutine SetServices(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - integer :: dbrc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) @@ -121,13 +113,14 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine SetServices !=============================================================================== subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_set_component_logging use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance @@ -149,7 +142,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(len=512) :: diro character(len=512) :: logfile integer :: localPet - integer :: dbrc character(len=16) :: inst_name ! fullname of current instance (ie. "wav_0001") character(len=CL) :: fileName ! generic file name integer :: inst_index ! number of current instance (ie. 1) @@ -157,7 +149,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! generate local mpi comm @@ -190,7 +182,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) filename = "dwav_in"//trim(inst_suffix) call dwav_shr_read_namelists(filename, mpicom, my_task, master_task, & - logunit, SDWAV, wav_present, wav_prognostic) + logunit, wav_present, wav_prognostic) !-------------------------------- ! advertise import and export fields @@ -198,11 +190,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call dwav_comp_advertise(importState, exportState, & wav_present, wav_prognostic, & - fldsFrWav_num, fldsFrWav, fldsToWav_num, fldsToWav, & - flds_w2x, flds_x2w, rc) + fldsFrWav_num, fldsFrWav, fldsToWav_num, fldsToWav, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! Reset shr logging to original values @@ -216,6 +207,8 @@ end subroutine InitializeAdvertise !=============================================================================== subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -235,12 +228,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) character(CL) :: cvalue integer :: shrlogunit ! original log unit integer :: shrloglev ! original log level - integer :: dbrc + integer :: nxg, nyg character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! Reset shr logging to my log file @@ -283,7 +276,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then calendar = shr_cal_gregorian else - call ESMF_LogWrite(subname//" ERROR bad ESMF calendar name "//trim(calendar), ESMF_LOGMSG_ERROR, rc=dbrc) + call ESMF_LogWrite(subname//" ERROR bad ESMF calendar name "//trim(calendar), ESMF_LOGMSG_ERROR) rc = ESMF_Failure return end if @@ -306,10 +299,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Initialize model !-------------------------------- - call dwav_comp_init(x2w, w2x, & - SDWAV, mpicom, compid, my_task, master_task, & + call dwav_comp_init(mpicom, compid, my_task, master_task, & inst_suffix, logunit, read_restart, & - current_ymd, current_tod, calendar, EMesh) + current_ymd, current_tod, calendar, EMesh, nxg, nyg) !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -317,7 +309,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! by replacing the advertised fields with the newly created fields of the same name. !-------------------------------- - call fld_list_realize( & + call dshr_realize( & state=ExportState, & fldList=fldsFrWav, & numflds=fldsFrWav_num, & @@ -327,39 +319,23 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) mesh=Emesh, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call fld_list_realize( & - state=importState, & - fldList=fldsToWav, & - numflds=fldsToWav_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':dwavImport',& - mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - !-------------------------------- ! Pack export state !-------------------------------- - call shr_nuopc_grid_ArrayToState(w2x%rattr, flds_w2x, exportState, grid_option='mesh', rc=rc) + call dwav_comp_export(exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDWAV%nxg),flds_scalar_index_nx, exportState, & + call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDWAV%nyg),flds_scalar_index_ny, exportState, & + call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - !-------------------------------- - ! diagnostics - !-------------------------------- - - if (debug_export > 0) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif + call shr_nuopc_methods_State_diagnose(exportState, subname//':ES', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) @@ -373,14 +349,17 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine InitializeRealize !=============================================================================== subroutine ModelAdvance(gcomp, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_memcheck, shr_nuopc_log_clock_advance + + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -398,13 +377,12 @@ subroutine ModelAdvance(gcomp, rc) integer :: day ! day in month integer :: next_ymd ! model date integer :: next_tod ! model sec into model date - integer :: dbrc character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) call shr_nuopc_memcheck(subname, 3, my_task==master_task) call shr_file_getLogUnit (shrlogunit) @@ -419,17 +397,12 @@ subroutine ModelAdvance(gcomp, rc) call NUOPC_ModelGet(gcomp, modelClock=clock, importState=importState, exportState=exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (debug_export > 0 .and. my_task == master_task) then - call shr_nuopc_methods_Clock_TimePrint(clock,subname//'clock',rc=rc) - endif - !-------------------------------- ! Unpack import state !-------------------------------- if (wav_prognostic) then - call shr_nuopc_grid_StateToArray(importState, x2w%rattr, flds_x2w, grid_option='mesh', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! no import data for now end if !-------------------------------- @@ -462,8 +435,7 @@ subroutine ModelAdvance(gcomp, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yr, mon, day, next_ymd) - call dwav_comp_run(x2w, w2x, & - SDWAV, mpicom, my_task, master_task, & + call dwav_comp_run(mpicom, my_task, master_task, & inst_suffix, logunit, read_restart, write_restart, & next_ymd, next_tod, case_name=case_name) @@ -471,23 +443,21 @@ subroutine ModelAdvance(gcomp, rc) ! Pack export state !-------------------------------- - call shr_nuopc_grid_ArrayToState(w2x%rattr, flds_w2x, exportState, grid_option='mesh', rc=rc) + call dwav_comp_export(exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics !-------------------------------- - if (debug_export > 0) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif + call shr_nuopc_methods_State_diagnose(exportState, subname//':ES', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return if (my_task == master_task) then call shr_nuopc_log_clock_advance(clock, 'WAV', logunit) end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) @@ -501,20 +471,19 @@ subroutine ModelFinalize(gcomp, rc) integer, intent(out) :: rc ! local variables - integer :: dbrc character(*), parameter :: F00 = "('(dwav_comp_final) ',8a)" character(*), parameter :: F91 = "('(dwav_comp_final) ',73('-'))" character(len=*),parameter :: subname=trim(modName)//':(ModelFinalize) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) if (my_task == master_task) then write(logunit,F91) write(logunit,F00) ' dwav : end of main integration loop' write(logunit,F91) end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine ModelFinalize diff --git a/src/components/stub_comps/siac/cime_config/buildlib b/src/components/stub_comps/siac/cime_config/buildlib new file mode 120000 index 000000000000..9601a6fa7cc2 --- /dev/null +++ b/src/components/stub_comps/siac/cime_config/buildlib @@ -0,0 +1 @@ +../../../../build_scripts/buildlib.internal_components \ No newline at end of file diff --git a/src/components/stub_comps/siac/cime_config/buildnml b/src/components/stub_comps/siac/cime_config/buildnml new file mode 100755 index 000000000000..6ddff93c44da --- /dev/null +++ b/src/components/stub_comps/siac/cime_config/buildnml @@ -0,0 +1,7 @@ +#!/usr/bin/env python + +""" +build stub model namelist +""" + +# DO NOTHING diff --git a/src/components/stub_comps/siac/cime_config/config_component.xml b/src/components/stub_comps/siac/cime_config/config_component.xml new file mode 100644 index 000000000000..65e6f18341ee --- /dev/null +++ b/src/components/stub_comps/siac/cime_config/config_component.xml @@ -0,0 +1,26 @@ + + + + + + + + Stub iac component + + + + char + siac + siac + case_comp + env_case.xml + Name of iac component + + + + ========================================= + SIAC naming conventions in compset name + ========================================= + + + diff --git a/src/components/stub_comps/siac/mct/iac_comp_mct.F90 b/src/components/stub_comps/siac/mct/iac_comp_mct.F90 new file mode 100644 index 000000000000..2c87fecb4885 --- /dev/null +++ b/src/components/stub_comps/siac/mct/iac_comp_mct.F90 @@ -0,0 +1,114 @@ +module iac_comp_mct + +! !USES: + + use mct_mod + use esmf + use seq_cdata_mod + use seq_infodata_mod + +! +! !PUBLIC TYPES: + implicit none + save + private ! except + +!-------------------------------------------------------------------------- +! Public interfaces +!-------------------------------------------------------------------------- + + public :: iac_init_mct + public :: iac_run_mct + public :: iac_final_mct +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +CONTAINS +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: iac_init_mct +! +! !DESCRIPTION: +! stub iac model init +! +! !REVISION HISTORY: +! +! !INTERFACE: ------------------------------------------------------------------ + + subroutine iac_init_mct( EClock, cdata, x2d, d2x, NLFilename ) + +! !INPUT/OUTPUT PARAMETERS: + + type(ESMF_Clock) , intent(inout) :: EClock + type(seq_cdata) , intent(inout) :: cdata + type(mct_aVect) , intent(inout) :: x2d, d2x + character(len=*), optional , intent(in) :: NLFilename + +!EOP +!------------------------------------------------------------------------------- + + call seq_infodata_PutData(cdata%infodata, & + iac_present=.false., iac_prognostic=.false.) + +end subroutine iac_init_mct + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: iac_run_mct +! +! !DESCRIPTION: +! stub iac model run +! +! !REVISION HISTORY: +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine iac_run_mct( EClock, cdata, x2d, d2x) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + type(ESMF_Clock) ,intent(inout) :: EClock + type(seq_cdata) ,intent(inout) :: cdata + type(mct_aVect) ,intent(inout) :: x2d + type(mct_aVect) ,intent(inout) :: d2x + +!EOP +!------------------------------------------------------------------------------- + +end subroutine iac_run_mct + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: iac_final_mct +! +! !DESCRIPTION: +! stub iac model finalize +! +! !REVISION HISTORY: +! +! !INTERFACE: ------------------------------------------------------------------ +! +subroutine iac_final_mct( EClock, cdata, x2d, d2x) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + type(ESMF_Clock) ,intent(inout) :: EClock + type(seq_cdata) ,intent(inout) :: cdata + type(mct_aVect) ,intent(inout) :: x2d + type(mct_aVect) ,intent(inout) :: d2x + +!EOP +!------------------------------------------------------------------------------- + + end subroutine iac_final_mct + +!=============================================================================== + +end module iac_comp_mct diff --git a/src/components/xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 b/src/components/xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 index dd54be4b7a58..c54f1602041d 100644 --- a/src/components/xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 @@ -3,6 +3,7 @@ module atm_comp_nuopc !---------------------------------------------------------------------------- ! This is the NUOPC cap for XATM !---------------------------------------------------------------------------- + use ESMF use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise @@ -11,11 +12,8 @@ module atm_comp_nuopc use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet - use med_constants_mod , only : IN, R8, I8, CXX, CL, CS - use med_constants_mod , only : shr_log_Unit + use med_constants_mod , only : R8, CL, CS use med_constants_mod , only : shr_file_getlogunit, shr_file_setlogunit - use med_constants_mod , only : shr_file_getloglevel, shr_file_setloglevel - use med_constants_mod , only : shr_file_setIO, shr_file_getUnit use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_scalars_mod , only : flds_scalar_num use shr_nuopc_scalars_mod , only : flds_scalar_index_nx @@ -24,14 +22,11 @@ module atm_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_Clock_TimePrint use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_GetFldPtr - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_nuopc_grid_mod , only : shr_nuopc_grid_Meshinit + use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_ChkErr use dead_nuopc_mod , only : dead_grid_lat, dead_grid_lon, dead_grid_index - use dead_nuopc_mod , only : dead_init_nuopc, dead_run_nuopc, dead_final_nuopc + use dead_nuopc_mod , only : dead_init_nuopc, dead_final_nuopc, dead_meshinit use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - use dead_nuopc_mod , only : state_getimport, state_setexport - use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, Print_FieldExchInfo + use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock use med_constants_mod , only : dbug => med_constants_dbug_flag implicit none @@ -43,102 +38,96 @@ module atm_comp_nuopc ! Private module data !-------------------------------------------------------------------------- - integer :: fldsToAtm_num = 0 - integer :: fldsFrAtm_num = 0 - type (fld_list_type) :: fldsToAtm(fldsMax) - type (fld_list_type) :: fldsFrAtm(fldsMax) - real(r8), pointer :: gbuf(:,:) ! model info - real(r8), pointer :: lat(:) - real(r8), pointer :: lon(:) - integer , allocatable :: gindex(:) - real(r8), allocatable :: x2d(:,:) - real(r8), allocatable :: d2x(:,:) - integer :: nxg ! global dim i-direction - integer :: nyg ! global dim j-direction - integer :: my_task ! my task in mpi communicator - integer :: inst_index ! number of current instance (ie. 1) - character(len=12) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=5) :: inst_suffix ! char string associated with instance (ie. "_0001" or "") - integer :: logunit ! logging unit number - logical :: mastertask - logical :: atm_prognostic - - !----- formats ----- + integer :: fldsToAtm_num = 0 + integer :: fldsFrAtm_num = 0 + type (fld_list_type) :: fldsToAtm(fldsMax) + type (fld_list_type) :: fldsFrAtm(fldsMax) + integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost + + real(r8), pointer :: gbuf(:,:) ! model info + real(r8), pointer :: lat(:) + real(r8), pointer :: lon(:) + integer , allocatable :: gindex(:) + integer :: nxg ! global dim i-direction + integer :: nyg ! global dim j-direction + integer :: inst_index ! number of current instance (ie. 1) + character(len=12) :: inst_name ! fullname of current instance (ie. "lnd_0001") + character(len=5) :: inst_suffix ! char string associated with instance (ie. "_0001" or "") + integer :: logunit ! logging unit number + logical :: mastertask character(*),parameter :: modName = "(xatm_comp_nuopc)" - character(*),parameter :: u_FILE_u = __FILE__ + character(*),parameter :: u_FILE_u = & + __FILE__ - - !=============================================================================== - contains - !=============================================================================== +!=============================================================================== +contains +!=============================================================================== subroutine SetServices(gcomp, rc) + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! switching to IPD versions call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & userRoutine=ModelInitPhase, phase=0, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! set entry point for methods that require specific implementation call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p1"/), & userRoutine=InitializeAdvertise, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p3"/), & userRoutine=InitializeRealize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! attach specializing method(s) call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, specRoutine=ModelAdvance, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end subroutine SetServices !=============================================================================== subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_set_component_logging use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc ! local variables - type(ESMF_VM) :: vm - character(CL) :: cvalue - character(CS) :: stdname - integer :: n - integer :: lsize ! local array size - integer :: ierr ! error code - integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - logical :: isPresent - character(len=512) :: diro - character(len=512) :: logfile + integer :: n + integer :: my_task ! my task in mpi communicator + type(ESMF_VM) :: vm + character(CS) :: stdname + integer :: lsize ! local array size + integer :: shrlogunit ! original log unit character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -146,12 +135,13 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localpet=my_task, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return + + mastertask = (my_task==0) - mastertask = my_task==0 !---------------------------------------------------------------------------- ! determine instance information !---------------------------------------------------------------------------- @@ -163,7 +153,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit, shrloglev) + call shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit) !---------------------------------------------------------------------------- ! Initialize xatm @@ -206,27 +196,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_swndf' ) call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_swvdf' ) call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_swnet' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_bcphidry' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_bcphodry' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_bcphiwet' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_ocphidry' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_ocphodry' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_ocphiwet' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstwet1' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstwet2' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstwet3' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstwet4' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstdry1' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstdry2' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstdry3' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstdry4' ) - - do n = 1,fldsFrAtm_num - if(mastertask) write(logunit,*)'Advertising From Xatm ',trim(fldsFrAtm(n)%stdname) - call NUOPC_Advertise(exportState, standardName=fldsFrAtm(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end do + call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_bcph' , ungridded_lbound=1, ungridded_ubound=3) + call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_ocph' , ungridded_lbound=1, ungridded_ubound=3) + call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstwet', ungridded_lbound=1, ungridded_ubound=4) + call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstdry', ungridded_lbound=1, ungridded_ubound=4) call fld_list_add(fldsToAtm_num, fldsToAtm, trim(flds_scalar_name)) call fld_list_add(fldsToAtm_num, fldsToAtm, 'Sx_anidr' ) @@ -254,22 +227,25 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToAtm_num, fldsToAtm, 'Faxx_lwup' ) call fld_list_add(fldsToAtm_num, fldsToAtm, 'Faxx_evap' ) + do n = 1,fldsFrAtm_num + if(mastertask) write(logunit,*)'Advertising From Xatm ',trim(fldsFrAtm(n)%stdname) + call NUOPC_Advertise(exportState, standardName=fldsFrAtm(n)%stdname, & + TransferOfferGeomObject='will provide', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end do + do n = 1,fldsToAtm_num if(mastertask) write(logunit,*)'Advertising To Xatm',trim(fldsToAtm(n)%stdname) call NUOPC_Advertise(importState, standardName=fldsToAtm(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return enddo - - allocate(d2x(FldsFrAtm_num,lsize)); d2x(:,:) = 0._r8 - allocate(x2d(FldsToAtm_num,lsize)); x2d(:,:) = 0._r8 end if !---------------------------------------------------------------------------- ! Reset shr logging to original values !---------------------------------------------------------------------------- - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -279,6 +255,8 @@ end subroutine InitializeAdvertise !=============================================================================== subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + + ! input/output arguments type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -291,7 +269,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) real(r8) :: nextsw_cday integer :: n integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize: xatm) ' !------------------------------------------------------------------------------- @@ -303,16 +280,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logUnit) !-------------------------------- ! generate the mesh !-------------------------------- - call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dead_meshinit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -328,7 +303,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':datmExport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call fld_list_realize( & state=importState, & @@ -338,51 +313,40 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':datmImport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Pack export state - ! Copy from d2x to exportState - ! Set the coupling scalars !-------------------------------- - do n = 1, FldsFrAtm_num - if (fldsFrAtm(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrAtm(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do + call state_setexport(exportState, rc=rc) call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Set time of next radiation computation call ESMF_ClockGetNextTime(clock, nextTime) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(nextTime, dayOfYear_r8=nextsw_cday) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics !-------------------------------- if (dbug > 1) then - if (mastertask) then - call Print_FieldExchInfo(values=d2x, logunit=logunit, & - fldlist=fldsFrAtm, nflds=fldsFrAtm_num, istr="InitializeRealize: atm->mediator") - end if call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return endif #ifdef USE_ESMF_METADATA @@ -398,7 +362,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_AttributeSet(comp, "ModelType", "Sea Ice", convention=convCIM, purpose=purpComp, rc=rc) #endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -408,7 +371,10 @@ end subroutine InitializeRealize !=============================================================================== subroutine ModelAdvance(gcomp, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_memcheck, shr_nuopc_log_clock_advance + + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -417,19 +383,18 @@ subroutine ModelAdvance(gcomp, rc) type(ESMF_Time) :: nexttime type(ESMF_State) :: exportState real(r8) :: nextsw_cday - integer :: n integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - real(r8), pointer :: dataptr(:) character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) + + if (dbug > 1) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) + end if call shr_nuopc_memcheck(subname, 3, mastertask) + call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) !-------------------------------- @@ -437,48 +402,125 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call NUOPC_ModelGet(gcomp, modelClock=clock, exportState=exportState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call dead_run_nuopc('atm', d2x, gbuf) + if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1, FldsFrAtm_num - if (fldsFrAtm(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrAtm(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do + call state_setexport(exportState, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGetNextTime(clock, nextTime) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(nextTime, dayOfYear_r8=nextsw_cday) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics !-------------------------------- if (dbug > 1) then - if (mastertask) then - call Print_FieldExchInfo(values=d2x, logunit=logunit, & - fldlist=fldsFrAtm, nflds=fldsFrAtm_num, istr="ModelAdvance: atm->mediator") - end if call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif - if(mastertask) then - call shr_nuopc_log_clock_advance(clock, 'ATM', logunit) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (mastertask) then + call shr_nuopc_log_clock_advance(clock, 'ATM', logunit) + endif endif - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) + + if (dbug > 5) then + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) + end if end subroutine ModelAdvance !=============================================================================== + subroutine state_setexport(exportState, rc) + + ! input/output variables + type(ESMF_State) , intent(inout) :: exportState + integer, intent(out) :: rc + + ! local variables + integer :: nf, nind + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Start from index 2 in order to Skip the scalar field here + do nf = 2,fldsFrAtm_num + if (fldsFrAtm(nf)%ungridded_ubound == 0) then + call field_setexport(exportState, trim(fldsFrAtm(nf)%stdname), lon, lat, nf=nf, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + do nind = 1,fldsFrAtm(nf)%ungridded_ubound + call field_setexport(exportState, trim(fldsFrAtm(nf)%stdname), lon, lat, nf=nf+nind-1, & + ungridded_index=nind, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end do + end if + end do + + end subroutine state_setexport + + !=============================================================================== + + subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, rc) + + use shr_const_mod , only : pi=>shr_const_pi + + ! intput/otuput variables + type(ESMF_State) , intent(inout) :: exportState + character(len=*) , intent(in) :: fldname + real(r8) , intent(in) :: lon(:) + real(r8) , intent(in) :: lat(:) + integer , intent(in) :: nf + integer, optional , intent(in) :: ungridded_index + integer , intent(out) :: rc + + ! local variables + integer :: i, ncomp + type(ESMF_Field) :: lfield + real(r8), pointer :: data1d(:) + real(r8), pointer :: data2d(:,:) + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(exportState, itemName=trim(fldname), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ncomp = 1 + if (present(ungridded_index)) then + call ESMF_FieldGet(lfield, farrayPtr=data2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (gridToFieldMap == 1) then + do i = 1,size(data2d, dim=1) + data2d(i,ungridded_index) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + else if (gridToFieldMap == 2) then + do i = 1,size(data2d, dim=2) + data2d(ungridded_index,i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + end if + else + call ESMF_FieldGet(lfield, farrayPtr=data1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do i = 1,size(data1d) + data1d(i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + end if + + end subroutine field_setexport + + !=============================================================================== + subroutine ModelFinalize(gcomp, rc) + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc diff --git a/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 b/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 index a2bad2375d87..277bda92e183 100644 --- a/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 @@ -14,7 +14,6 @@ module glc_comp_nuopc use med_constants_mod , only : IN, R8, I8, CXX, CL, CS use med_constants_mod , only : shr_log_Unit use med_constants_mod , only : shr_file_getlogunit, shr_file_setlogunit - use med_constants_mod , only : shr_file_getloglevel, shr_file_setloglevel use med_constants_mod , only : shr_file_setIO, shr_file_getUnit use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_scalars_mod , only : flds_scalar_num @@ -24,13 +23,13 @@ module glc_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_getFldPtr - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_nuopc_grid_mod , only : shr_nuopc_grid_Meshinit + use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_ChkErr use dead_nuopc_mod , only : dead_grid_lat, dead_grid_lon, dead_grid_index - use dead_nuopc_mod , only : dead_init_nuopc, dead_run_nuopc, dead_final_nuopc + use dead_nuopc_mod , only : dead_init_nuopc, dead_final_nuopc, dead_meshinit use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - use dead_nuopc_mod , only : state_getimport, state_setexport - use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, Print_FieldExchInfo + use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock + use med_constants_mod , only : dbug => med_constants_dbug_flag + implicit none private ! except @@ -40,29 +39,28 @@ module glc_comp_nuopc ! Private module data !-------------------------------------------------------------------------- - integer :: fldsToGlc_num = 0 - integer :: fldsFrGlc_num = 0 - type (fld_list_type) :: fldsToGlc(fldsMax) - type (fld_list_type) :: fldsFrGlc(fldsMax) - real(r8), pointer :: gbuf(:,:) ! model info - real(r8), pointer :: lat(:) - real(r8), pointer :: lon(:) - integer , allocatable :: gindex(:) - real(r8), allocatable :: x2d(:,:) - real(r8), allocatable :: d2x(:,:) - integer :: nxg ! global dim i-direction - integer :: nyg ! global dim j-direction - integer :: my_task ! my task in mpi communicator mpicom - integer :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "glc_0001") - character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") - integer :: logunit ! logging unit number - integer ,parameter :: master_task=0 ! task number of master task - logical :: mastertask - character(len=*),parameter :: grid_option = "mesh" ! grid_de, grid_arb, grid_reg, mesh - integer, parameter :: dbug = 10 - character(*),parameter :: modName = "(xglc_comp_nuopc)" - character(*),parameter :: u_FILE_u = __FILE__ + integer :: fldsToGlc_num = 0 + integer :: fldsFrGlc_num = 0 + type (fld_list_type) :: fldsToGlc(fldsMax) + type (fld_list_type) :: fldsFrGlc(fldsMax) + integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost + + real(r8), pointer :: gbuf(:,:) ! model info + real(r8), pointer :: lat(:) + real(r8), pointer :: lon(:) + integer , allocatable :: gindex(:) + integer :: nxg ! global dim i-direction + integer :: nyg ! global dim j-direction + integer :: my_task ! my task in mpi communicator mpicom + integer :: inst_index ! number of current instance (ie. 1) + character(len=16) :: inst_name ! fullname of current instance (ie. "glc_0001") + character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") + integer :: logunit ! logging unit number + integer ,parameter :: master_task=0 ! task number of master task + logical :: mastertask + character(*),parameter :: modName = "(xglc_comp_nuopc)" + character(*),parameter :: u_FILE_u = & + __FILE__ !=============================================================================== contains @@ -75,47 +73,47 @@ subroutine SetServices(gcomp, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! switching to IPD versions call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & userRoutine=ModelInitPhase, phase=0, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! set entry point for methods that require specific implementation call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p1"/), & userRoutine=InitializeAdvertise, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p3"/), & userRoutine=InitializeRealize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! attach specializing method(s) call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, specRoutine=ModelAdvance, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end subroutine SetServices !=============================================================================== subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - use glc_elevclass_mod, only : glc_elevclass_as_string + use shr_nuopc_utils_mod, only : shr_nuopc_set_component_logging use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance @@ -136,7 +134,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: lsize ! local array size integer :: ierr ! error code integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level logical :: isPresent character(len=512) :: diro character(len=512) :: logfile @@ -147,10 +144,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localpet=my_task, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return mastertask = my_task == master_task @@ -165,7 +162,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit, shrloglev) + call shr_nuopc_set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit) !---------------------------------------------------------------------------- ! Initialize xglc @@ -185,12 +182,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! advertise import and export fields !-------------------------------- - ! initialize number of elevation classes - call NUOPC_CompAttributeGet(gcomp, name='glc_nec', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) glc_nec - call ESMF_LogWrite('glc_nec = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) - if (nxg /= 0 .and. nyg /= 0) then call fld_list_add(fldsFrGlc_num, fldsFrGlc, trim(flds_scalar_name)) @@ -200,33 +191,24 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrGlc_num, fldsFrGlc, 'Sg_topo' ) call fld_list_add(fldsFrGlc_num, fldsFrGlc, 'Flgg_hflx' ) + call fld_list_add(fldsToGlc_num, fldsToGlc, trim(flds_scalar_name)) + call fld_list_add(fldsToGlc_num, fldsToGlc, 'Sl_tsrf') + call fld_list_add(fldsToGlc_num, fldsToGlc, 'Sl_topo') + call fld_list_add(fldsToGlc_num, fldsToGlc, 'Flgg_hflx') + do n = 1,fldsFrGlc_num if (mastertask) write(logunit,*)'Advertising From Xglc ',trim(fldsFrGlc(n)%stdname) call NUOPC_Advertise(exportState, standardName=fldsFrglc(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return enddo - call fld_list_add(fldsToGlc_num, fldsToGlc, trim(flds_scalar_name)) - do num = 0,glc_nec - nec_str = glc_elevclass_as_string(num) - fldname = 'Sl_tsrf' // nec_str - call fld_list_add(fldsToGlc_num, fldsToGlc, trim(fldname)) - fldname = 'Sl_topo' // nec_str - call fld_list_add(fldsToGlc_num, fldsToGlc, trim(fldname)) - fldname = 'Flgl_qice' // nec_str - call fld_list_add(fldsToGlc_num, fldsToGlc, trim(fldname)) - end do - do n = 1,fldsToGlc_num if (mastertask) write(logunit,*)'Advertising To Xglc ',trim(fldsToGlc(n)%stdname) call NUOPC_Advertise(importState, standardName=fldsToglc(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return enddo - - allocate(d2x(FldsFrGlc_num,lsize)); d2x(:,:) = 0._r8 - allocate(x2d(FldsToGlc_num,lsize)); x2d(:,:) = 0._r8 end if if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -235,7 +217,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Reset shr logging to original values !---------------------------------------------------------------------------- - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) end subroutine InitializeAdvertise @@ -243,6 +224,8 @@ end subroutine InitializeAdvertise !=============================================================================== subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -252,7 +235,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) character(ESMF_MAXSTR) :: convCIM, purpComp type(ESMF_Mesh) :: Emesh integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level integer :: n character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' !------------------------------------------------------------------------------- @@ -265,7 +247,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) call shr_file_setLogUnit (logunit) !-------------------------------- @@ -273,8 +254,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! grid_option specifies grid or mesh !-------------------------------- - call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dead_meshinit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -290,7 +271,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':dglcExport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call fld_list_realize( & state=importState, & @@ -300,7 +281,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':dglcImport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Pack export state @@ -308,32 +289,24 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Set the coupling scalars !-------------------------------- - do n = 1, FldsFrGlc_num - if (fldsFrGlc(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrGlc(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do + call state_setexport(exportState, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics !-------------------------------- if (dbug > 1) then - if (my_task == master_task) then - call Print_FieldExchInfo(values=d2x, logunit=logunit, & - fldlist=fldsFrGlc, nflds=fldsFrGlc_num, istr="InitializeRealize: glc->mediator") - end if call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return endif #ifdef USE_ESMF_METADATA @@ -349,7 +322,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_AttributeSet(comp, "ModelType", "Land-Ice", convention=convCIM, purpose=purpComp, rc=rc) #endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -359,6 +331,7 @@ end subroutine InitializeRealize !=============================================================================== subroutine ModelAdvance(gcomp, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_memcheck, shr_nuopc_log_clock_advance ! input/output variables @@ -370,7 +343,6 @@ subroutine ModelAdvance(gcomp, rc) type(ESMF_State) :: exportState integer :: n integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level real(r8), pointer :: dataptr(:) character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- @@ -379,8 +351,6 @@ subroutine ModelAdvance(gcomp, rc) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call shr_nuopc_memcheck(subname, 3, mastertask) call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) !-------------------------------- @@ -388,35 +358,10 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call NUOPC_ModelGet(gcomp, modelClock=clock, exportState=exportState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return - call dead_run_nuopc('glc', d2x, gbuf) - - do n = 1, FldsFrGlc_num - if (fldsFrGlc(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrGlc(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do - - ! Reset some fields - call shr_nuopc_methods_State_GetFldPtr(exportState, fldname='Sg_icemask', fldptr1=dataptr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(dataptr) - dataptr(n) = 1.0_R8 - end do - - call shr_nuopc_methods_State_GetFldPtr(exportState, fldname='Sg_icemask_coupled_fluxes', fldptr1=dataptr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(dataptr) - dataptr(n) = 1.0_R8 - end do - - call shr_nuopc_methods_State_GetFldPtr(exportState, fldname='Sg_ice_covered', fldptr1=dataptr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(dataptr) - dataptr(n) = 1.0_R8 - end do + call state_setexport(exportState, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics @@ -424,13 +369,12 @@ subroutine ModelAdvance(gcomp, rc) if (dbug > 1) then call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (my_task == master_task) then call shr_nuopc_log_clock_advance(clock, 'GLC', logunit) endif endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -439,6 +383,99 @@ end subroutine ModelAdvance !=============================================================================== + subroutine state_setexport(exportState, rc) + + ! input/output variables + type(ESMF_State) , intent(inout) :: exportState + integer, intent(out) :: rc + + ! local variables + integer :: nf, nind + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Start from index 2 in order to skip the scalar field + do nf = 2,fldsFrGlc_num + if (fldsFrGlc(nf)%ungridded_ubound == 0) then + call field_setexport(exportState, trim(fldsFrGlc(nf)%stdname), lon, lat, nf=nf, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + do nind = 1,fldsFrGlc(nf)%ungridded_ubound + call field_setexport(exportState, trim(fldsFrGlc(nf)%stdname), lon, lat, nf=nf+nind-1, & + ungridded_index=nind, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end do + end if + end do + + end subroutine state_setexport + + !=============================================================================== + + subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, rc) + + use shr_const_mod , only : pi=>shr_const_pi + + ! intput/otuput variables + type(ESMF_State) , intent(inout) :: exportState + character(len=*) , intent(in) :: fldname + real(r8) , intent(in) :: lon(:) + real(r8) , intent(in) :: lat(:) + integer , intent(in) :: nf + integer, optional , intent(in) :: ungridded_index + integer , intent(out) :: rc + + ! local variables + integer :: i, ncomp + type(ESMF_Field) :: lfield + real(r8), pointer :: data1d(:) + real(r8), pointer :: data2d(:,:) + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(exportState, itemName=trim(fldname), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ncomp = 5 + if (present(ungridded_index)) then + call ESMF_FieldGet(lfield, farrayPtr=data2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (gridToFieldMap == 1) then + do i = 1,size(data2d, dim=1) + data2d(i,ungridded_index) = (nf*100) & + * cos (pi*lat(i)/180.0_R8) * cos (pi*lat(i)/180.0_R8) & + * sin (pi*lon(i)/180.0_R8) * sin (pi*lon(i)/180.0_R8) & + + (ncomp*10.0_R8) + enddo + else if (gridToFieldMap == 2) then + do i = 1,size(data2d, dim=2) + data2d(ungridded_index,i) = (nf*100) & + * cos (pi*lat(i)/180.0_R8) * cos (pi*lat(i)/180.0_R8) & + * sin (pi*lon(i)/180.0_R8) * sin (pi*lon(i)/180.0_R8) & + + (ncomp*10.0_R8) + end do + end if + else + call ESMF_FieldGet(lfield, farrayPtr=data1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (fldname == 'Sg_icemask' .or. 'fldname == Sg_icemask_coupled_fluxes' .or. fldname == 'Sg_ice_covered') then + data1d(:) = 1._r8 + else + do i = 1,size(data1d) + data1d(i) = (nf*100) & + * cos (pi*lat(i)/180.0_R8) * cos (pi*lat(i)/180.0_R8) & + * sin (pi*lon(i)/180.0_R8) * sin (pi*lon(i)/180.0_R8) & + + (ncomp*10.0_R8) + end do + end if + end if + + end subroutine field_setexport + + !=============================================================================== + subroutine ModelFinalize(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc diff --git a/src/components/xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 b/src/components/xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 index 77ff99cc341c..7aedeb6d28a1 100644 --- a/src/components/xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 @@ -3,6 +3,7 @@ module ice_comp_nuopc !---------------------------------------------------------------------------- ! This is the NUOPC cap for XICE !---------------------------------------------------------------------------- + use ESMF use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise @@ -11,11 +12,8 @@ module ice_comp_nuopc use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet - use med_constants_mod , only : IN, R8, I8, CXX, CL, CS - use med_constants_mod , only : shr_log_Unit + use med_constants_mod , only : R8, CL, CS use med_constants_mod , only : shr_file_getlogunit, shr_file_setlogunit - use med_constants_mod , only : shr_file_getloglevel, shr_file_setloglevel - use med_constants_mod , only : shr_file_setIO, shr_file_getUnit use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_scalars_mod , only : flds_scalar_num use shr_nuopc_scalars_mod , only : flds_scalar_index_nx @@ -24,13 +22,11 @@ module ice_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_GetFldPtr - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_nuopc_grid_mod , only : shr_nuopc_grid_Meshinit + use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_ChkErr use dead_nuopc_mod , only : dead_grid_lat, dead_grid_lon, dead_grid_index - use dead_nuopc_mod , only : dead_init_nuopc, dead_run_nuopc, dead_final_nuopc + use dead_nuopc_mod , only : dead_init_nuopc, dead_final_nuopc, dead_meshinit use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - use dead_nuopc_mod , only : state_getimport, state_setexport - use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, Print_FieldExchInfo + use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock use med_constants_mod , only : dbug => med_constants_dbug_flag implicit none @@ -46,13 +42,12 @@ module ice_comp_nuopc integer :: fldsFrIce_num = 0 type (fld_list_type) :: fldsToIce(fldsMax) type (fld_list_type) :: fldsFrIce(fldsMax) + integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost real(r8), pointer :: gbuf(:,:) ! model info real(r8), pointer :: lat(:) real(r8), pointer :: lon(:) integer , allocatable :: gindex(:) - real(r8), allocatable :: x2d(:,:) - real(r8), allocatable :: d2x(:,:) integer :: nxg ! global dim i-direction integer :: nyg ! global dim j-direction integer :: my_task ! my task in mpi communicator mpicom @@ -61,8 +56,7 @@ module ice_comp_nuopc character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") integer :: logunit ! logging unit number integer ,parameter :: master_task=0 ! task number of master task - logical :: mastertask - character(len=*),parameter :: grid_option = "mesh" ! grid_de, grid_arb, grid_reg, mesh + logical :: mastertask character(*),parameter :: modName = "(xice_comp_nuopc)" character(*),parameter :: u_FILE_u = & __FILE__ @@ -77,46 +71,48 @@ subroutine SetServices(gcomp, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! switching to IPD versions call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & userRoutine=ModelInitPhase, phase=0, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! set entry point for methods that require specific implementation call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p1"/), & userRoutine=InitializeAdvertise, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p3"/), & userRoutine=InitializeRealize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! attach specializing method(s) call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, specRoutine=ModelAdvance, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end subroutine SetServices !=============================================================================== + subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_set_component_logging use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance @@ -131,12 +127,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(CS) :: stdname integer :: n integer :: lsize ! local array size - integer :: ierr ! error code integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - logical :: isPresent - character(len=512) :: diro - character(len=512) :: logfile character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -144,10 +135,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localpet=my_task, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return mastertask = my_task == master_task @@ -162,7 +153,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit, shrloglev) + call shr_nuopc_set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit) !---------------------------------------------------------------------------- ! Initialize xice @@ -178,7 +169,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) lat(:) = gbuf(:,dead_grid_lat) lon(:) = gbuf(:,dead_grid_lon) - !-------------------------------- ! advertise import and export fields !-------------------------------- @@ -214,13 +204,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrIce_num, fldsFrIce, 'Fioi_bcphi' ) call fld_list_add(fldsFrIce_num, fldsFrIce, 'Fioi_flxdst' ) - do n = 1,fldsFrIce_num - if(mastertask) write(logunit,*)'Advertising From Xice ',trim(fldsFrIce(n)%stdname) - call NUOPC_Advertise(exportState, standardName=fldsFrIce(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - enddo - call fld_list_add(fldsToIce_num, fldsToIce, trim(flds_scalar_name)) call fld_list_add(fldsToIce_num, fldsToIce, 'So_dhdx' ) call fld_list_add(fldsToIce_num, fldsToIce, 'So_dhdy' ) @@ -243,27 +226,24 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_lwdn' ) call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_rain' ) call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_snow' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_bcphodry' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_bcphidry' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_bcphiwet' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstdry1' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstdry2' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstdry3' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstdry4' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstwet1' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstwet2' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstwet3' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstwet4' ) + call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_bcph' , ungridded_lbound=1, ungridded_ubound=3) + call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_ocph' , ungridded_lbound=1, ungridded_ubound=3) + call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstwet', ungridded_lbound=1, ungridded_ubound=4) + call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstdry', ungridded_lbound=1, ungridded_ubound=4) + + do n = 1,fldsFrIce_num + if(mastertask) write(logunit,*)'Advertising From Xice ',trim(fldsFrIce(n)%stdname) + call NUOPC_Advertise(exportState, standardName=fldsFrIce(n)%stdname, & + TransferOfferGeomObject='will provide', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo do n = 1,fldsToIce_num if(mastertask) write(logunit,*)'Advertising To Xice ',trim(fldsToIce(n)%stdname) call NUOPC_Advertise(importState, standardName=fldsToIce(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end do - - allocate(d2x(FldsFrIce_num,lsize)); d2x(:,:) = 0._r8 - allocate(x2d(FldsToIce_num,lsize)); x2d(:,:) = 0._r8 end if @@ -273,7 +253,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Reset shr logging to original values !---------------------------------------------------------------------------- - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) end subroutine InitializeAdvertise @@ -290,7 +269,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) character(ESMF_MAXSTR) :: convCIM, purpComp type(ESMF_Mesh) :: Emesh integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level integer :: n character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' !------------------------------------------------------------------------------- @@ -303,16 +281,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logUnit) !-------------------------------- ! generate the mesh !-------------------------------- - call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dead_meshinit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -328,7 +304,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':diceExport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call fld_list_realize( & state=importState, & @@ -338,40 +314,30 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':diceImport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Pack export state - ! Copy from d2x to exportState - ! Set the coupling scalars !-------------------------------- - do n = 1, FldsFrIce_num - if (fldsFrIce(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrIce(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do + call state_setexport(exportState, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics !-------------------------------- if (dbug > 1) then - if (my_task == master_task) then - call Print_FieldExchInfo(values=d2x, logunit=logunit, & - fldlist=fldsFrIce, nflds=fldsFrIce_num, istr="InitializeRealize: ice->mediator") - end if call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return endif #ifdef USE_ESMF_METADATA @@ -387,7 +353,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_AttributeSet(comp, "ModelType", "Sea Ice", convention=convCIM, purpose=purpComp, rc=rc) #endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -397,6 +362,7 @@ end subroutine InitializeRealize !=============================================================================== subroutine ModelAdvance(gcomp, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_memcheck, shr_nuopc_log_clock_advance ! input/output variables @@ -406,19 +372,15 @@ subroutine ModelAdvance(gcomp, rc) ! local variables type(ESMF_Clock) :: clock type(ESMF_State) :: exportState - integer :: n integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - real(r8), pointer :: dataptr(:) character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call shr_nuopc_memcheck(subname, 3, mastertask) + call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) !-------------------------------- @@ -426,29 +388,10 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call NUOPC_ModelGet(gcomp, modelClock=clock, exportState=exportState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return - call dead_run_nuopc('ice', d2x, gbuf) - - do n = 1, FldsFrIce_num - if (fldsFrIce(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrIce(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do - - ! Reset some fields - call shr_nuopc_methods_State_GetFldPtr(exportState, fldname='Si_ifrac', fldptr1=dataptr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(dataptr) - dataptr(n) = min(1.0_R8,max(0.0_R8,dataptr(n))) - end do - - call shr_nuopc_methods_State_GetFldPtr(exportState, fldname='Si_imask', fldptr1=dataptr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(dataptr) - dataptr(n) = float(nint(min(1.0_R8,max(0.0_R8,dataptr(n))))) - end do + call state_setexport(exportState, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics @@ -456,13 +399,12 @@ subroutine ModelAdvance(gcomp, rc) if (dbug > 1) then call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (my_task == master_task) then call shr_nuopc_log_clock_advance(clock, 'ICE', logunit) endif endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -471,6 +413,99 @@ end subroutine ModelAdvance !=============================================================================== + subroutine state_setexport(exportState, rc) + + ! input/output variables + type(ESMF_State) , intent(inout) :: exportState + integer, intent(out) :: rc + + ! local variables + integer :: nf, nind + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Start from index 2 in order to skip the scalar field + do nf = 2,fldsFrIce_num + if (fldsFrIce(nf)%ungridded_ubound == 0) then + call field_setexport(exportState, trim(fldsFrIce(nf)%stdname), lon, lat, nf=nf, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + do nind = 1,fldsFrIce(nf)%ungridded_ubound + call field_setexport(exportState, trim(fldsFrIce(nf)%stdname), lon, lat, nf=nf+nind-1, & + ungridded_index=nind, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end do + end if + end do + + end subroutine state_setexport + + !=============================================================================== + + subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, rc) + + use shr_const_mod , only : pi=>shr_const_pi + + ! intput/otuput variables + type(ESMF_State) , intent(inout) :: exportState + character(len=*) , intent(in) :: fldname + real(r8) , intent(in) :: lon(:) + real(r8) , intent(in) :: lat(:) + integer , intent(in) :: nf + integer, optional , intent(in) :: ungridded_index + integer , intent(out) :: rc + + ! local variables + integer :: i, ncomp + type(ESMF_Field) :: lfield + real(r8), pointer :: data1d(:) + real(r8), pointer :: data2d(:,:) + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(exportState, itemName=trim(fldname), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ncomp = 3 + if (present(ungridded_index)) then + call ESMF_FieldGet(lfield, farrayPtr=data2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (gridToFieldMap == 1) then + do i = 1,size(data2d, dim=1) + data2d(i,ungridded_index) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + else if (gridToFieldMap == 2) then + do i = 1,size(data2d, dim=2) + data2d(ungridded_index,i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + end if + else + call ESMF_FieldGet(lfield, farrayPtr=data1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do i = 1,size(data1d) + data1d(i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + ! Reset some fields + if (fldname == 'Si_ifrac') then + do i = 1,size(data1d) + data1d(i) = min(1.0_R8,max(0.0_R8,data1d(i))) + end do + else if (fldname == 'Si_imask') then + do i = 1,size(data1d) + data1d(i) = float(nint(min(1.0_R8,max(0.0_R8,data1d(i))))) + end do + end if + end if + + end subroutine field_setexport + + !=============================================================================== + subroutine ModelFinalize(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc diff --git a/src/components/xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 b/src/components/xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 index adc89f1c78d4..f1feb98a0ed4 100644 --- a/src/components/xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 @@ -3,6 +3,7 @@ module lnd_comp_nuopc !---------------------------------------------------------------------------- ! This is the NUOPC cap for XLND !---------------------------------------------------------------------------- + use ESMF use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise @@ -11,11 +12,8 @@ module lnd_comp_nuopc use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet - use med_constants_mod , only : IN, R8, I8, CXX, CL, CS - use med_constants_mod , only : shr_log_Unit + use med_constants_mod , only : R8, CL, CS use med_constants_mod , only : shr_file_getlogunit, shr_file_setlogunit - use med_constants_mod , only : shr_file_getloglevel, shr_file_setloglevel - use med_constants_mod , only : shr_file_setIO, shr_file_getUnit use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_scalars_mod , only : flds_scalar_num use shr_nuopc_scalars_mod , only : flds_scalar_index_nx @@ -24,13 +22,11 @@ module lnd_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_getFldPtr - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_nuopc_grid_mod , only : shr_nuopc_grid_Meshinit + use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_ChkErr use dead_nuopc_mod , only : dead_grid_lat, dead_grid_lon, dead_grid_index - use dead_nuopc_mod , only : dead_init_nuopc, dead_run_nuopc, dead_final_nuopc + use dead_nuopc_mod , only : dead_init_nuopc, dead_final_nuopc, dead_meshinit use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - use dead_nuopc_mod , only : state_getimport, state_setexport - use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, Print_FieldExchInfo + use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock use med_constants_mod , only : dbug=>med_constants_dbug_flag implicit none @@ -46,13 +42,12 @@ module lnd_comp_nuopc integer :: fldsFrLnd_num = 0 type (fld_list_type) :: fldsToLnd(fldsMax) type (fld_list_type) :: fldsFrLnd(fldsMax) + integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost real(r8), pointer :: gbuf(:,:) ! model info real(r8), pointer :: lat(:) real(r8), pointer :: lon(:) integer , allocatable :: gindex(:) - real(r8), allocatable :: x2d(:,:) - real(r8), allocatable :: d2x(:,:) integer :: nxg ! global dim i-direction integer :: nyg ! global dim j-direction integer :: my_task ! my task in mpi communicator mpicom @@ -61,63 +56,68 @@ module lnd_comp_nuopc character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") integer :: logunit ! logging unit number integer ,parameter :: master_task=0 ! task number of master task - logical :: mastertask - character(len=*),parameter :: grid_option = "mesh" ! grid_de, grid_arb, grid_reg, mesh + logical :: mastertask character(*),parameter :: modName = "(xlnd_comp_nuopc)" character(*),parameter :: u_FILE_u = & __FILE__ !=============================================================================== contains - !=============================================================================== +!=============================================================================== + subroutine SetServices(gcomp, rc) + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! switching to IPD versions call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & userRoutine=ModelInitPhase, phase=0, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! set entry point for methods that require specific implementation call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p1"/), & userRoutine=InitializeAdvertise, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p3"/), & userRoutine=InitializeRealize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! attach specializing method(s) call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, specRoutine=ModelAdvance, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end subroutine SetServices + !=============================================================================== + subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_set_component_logging use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -131,7 +131,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: lsize ! local array size integer :: ierr ! error code integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level logical :: isPresent character(len=512) :: diro character(len=512) :: logfile @@ -142,10 +141,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localpet=my_task, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return mastertask = my_task == master_task @@ -160,7 +159,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit, shrloglev) + call shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit) !---------------------------------------------------------------------------- ! Initialize xlnd @@ -207,17 +206,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_lwup' ) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_evap' ) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_swnet' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_flxdst1' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_flxdst2' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_flxdst3' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_flxdst4' ) - - do n = 1,fldsFrLnd_num - if (mastertask) write(logunit,*)'Advertising From Xlnd ',trim(fldsFrLnd(n)%stdname) - call NUOPC_Advertise(exportState, standardName=fldsFrLnd(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - enddo + call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_flxdst', ungridded_lbound=1, ungridded_ubound=4) call fld_list_add(fldsToLnd_num, fldsToLnd, trim(flds_scalar_name)) call fld_list_add(fldsToLnd_num, fldsToLnd, 'Sa_z' ) @@ -239,30 +228,25 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_swvdr' ) call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_swndf' ) call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_swvdf' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_bcphidry') - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_bcphodry') - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_bcphiwet') - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_ocphidry') - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_ocphodry') - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_ocphiwet') - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstdry1' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstdry2' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstdry3' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstdry4' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstwet1' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstwet2' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstwet3' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstwet4' ) + call fld_list_add(fldsTolnd_num, fldsTolnd, 'Faxa_bcph' , ungridded_lbound=1, ungridded_ubound=3) + call fld_list_add(fldsTolnd_num, fldsTolnd, 'Faxa_ocph' , ungridded_lbound=1, ungridded_ubound=3) + call fld_list_add(fldsTolnd_num, fldsTolnd, 'Faxa_dstwet', ungridded_lbound=1, ungridded_ubound=4) + call fld_list_add(fldsTolnd_num, fldsTolnd, 'Faxa_dstdry', ungridded_lbound=1, ungridded_ubound=4) + + do n = 1,fldsFrLnd_num + if (mastertask) write(logunit,*)'Advertising From Xlnd ',trim(fldsFrLnd(n)%stdname) + call NUOPC_Advertise(exportState, standardName=fldsFrLnd(n)%stdname, & + TransferOfferGeomObject='will provide', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo do n = 1,fldsToLnd_num if(mastertask) write(logunit,*)'Advertising To Xlnd',trim(fldsToLnd(n)%stdname) call NUOPC_Advertise(importState, standardName=fldsToLnd(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return enddo - allocate(d2x(FldsFrLnd_num,lsize)); d2x(:,:) = 0._r8 - allocate(x2d(FldsToLnd_num,lsize)); x2d(:,:) = 0._r8 end if @@ -270,7 +254,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Reset shr logging to original values !---------------------------------------------------------------------------- - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) end subroutine InitializeAdvertise @@ -287,7 +270,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) character(ESMF_MAXSTR) :: convCIM, purpComp type(ESMF_Mesh) :: Emesh integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level type(ESMF_VM) :: vm integer :: n logical :: connected ! is field connected? @@ -302,16 +284,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logUnit) !-------------------------------- ! generate the mesh !-------------------------------- - call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dead_meshinit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -327,7 +307,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':dlndExport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call fld_list_realize( & state=importState, & @@ -337,40 +317,29 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':dlndImport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Pack export state - ! Copy from d2x to exportState - ! Set the coupling scalars !-------------------------------- - do n = 1, FldsFrLnd_num - if (fldsFrLnd(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrLnd(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do + call state_setexport(exportState, rc=rc) call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics !-------------------------------- if (dbug > 1) then - if (mastertask) then - call Print_FieldExchInfo(values=d2x, logunit=logunit, & - fldlist=fldsFrLnd, nflds=fldsFrLnd_num, istr="InitializeRealize: lnd->mediator") - end if call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return endif #ifdef USE_ESMF_METADATA @@ -386,7 +355,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_AttributeSet(comp, "ModelType", "Land", convention=convCIM, purpose=purpComp, rc=rc) #endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -396,6 +364,7 @@ end subroutine InitializeRealize !=============================================================================== subroutine ModelAdvance(gcomp, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_memcheck, shr_nuopc_log_clock_advance ! input/output variables @@ -405,19 +374,15 @@ subroutine ModelAdvance(gcomp, rc) ! local variables type(ESMF_Clock) :: clock type(ESMF_State) :: exportState - integer :: n integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - real(r8), pointer :: dataptr(:) character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call shr_nuopc_memcheck(subname, 3, mastertask) + call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) !-------------------------------- @@ -425,41 +390,22 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call NUOPC_ModelGet(gcomp, modelClock=clock, exportState=exportState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call dead_run_nuopc('lnd', d2x, gbuf) + if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1, FldsFrLnd_num - if (fldsFrLnd(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrLnd(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do - - ! Reset some fields - call shr_nuopc_methods_State_GetFldPtr(exportState, fldname='Sl_lfrin', fldptr1=dataptr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(dataptr) - dataptr(n) = 1._r8 - end do + call state_setexport(exportState, rc=rc) !-------------------------------- ! diagnostics !-------------------------------- if (dbug > 1) then - if (mastertask) then - call Print_FieldExchInfo(values=d2x, logunit=logunit, & - fldlist=fldsFrLnd, nflds=fldsFrLnd_num, istr="ModelAdvance: lnd->mediator") - end if call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif - if(mastertask) then - call shr_nuopc_log_clock_advance(clock, 'LND', logunit) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (mastertask) then + call shr_nuopc_log_clock_advance(clock, 'LND', logunit) + endif endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -468,6 +414,93 @@ end subroutine ModelAdvance !=============================================================================== + subroutine state_setexport(exportState, rc) + + ! input/output variables + type(ESMF_State) , intent(inout) :: exportState + integer, intent(out) :: rc + + ! local variables + integer :: nf, nind + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Start from index 2 in order to Skip the scalar field here + do nf = 2,fldsFrLnd_num + if (fldsFrLnd(nf)%ungridded_ubound == 0) then + call field_setexport(exportState, trim(fldsFrLnd(nf)%stdname), lon, lat, nf=nf, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + do nind = 1,fldsFrLnd(nf)%ungridded_ubound + call field_setexport(exportState, trim(fldsFrLnd(nf)%stdname), lon, lat, nf=nf+nind-1, & + ungridded_index=nind, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end do + end if + end do + + end subroutine state_setexport + + !=============================================================================== + + subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, rc) + + use shr_const_mod , only : pi=>shr_const_pi + + ! intput/otuput variables + type(ESMF_State) , intent(inout) :: exportState + character(len=*) , intent(in) :: fldname + real(r8) , intent(in) :: lon(:) + real(r8) , intent(in) :: lat(:) + integer , intent(in) :: nf + integer, optional , intent(in) :: ungridded_index + integer , intent(out) :: rc + + ! local variables + integer :: i, ncomp + type(ESMF_Field) :: lfield + real(r8), pointer :: data1d(:) + real(r8), pointer :: data2d(:,:) + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(exportState, itemName=trim(fldname), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ncomp = 2 + if (present(ungridded_index)) then + call ESMF_FieldGet(lfield, farrayPtr=data2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (gridToFieldMap == 1) then + do i = 1,size(data2d, dim=1) + data2d(i,ungridded_index) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + else if (gridToFieldMap == 2) then + do i = 1,size(data2d, dim=2) + data2d(ungridded_index,i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + end if + else + call ESMF_FieldGet(lfield, farrayPtr=data1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (fldname == 'Sl_lfrin') then + data1d(:) = 1._r8 + else + do i = 1,size(data1d) + data1d(i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + end if + end if + + end subroutine field_setexport + + !=============================================================================== + subroutine ModelFinalize(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc diff --git a/src/components/xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 b/src/components/xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 index 7abd2afaa028..259121b447fa 100644 --- a/src/components/xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 @@ -3,6 +3,7 @@ module ocn_comp_nuopc !---------------------------------------------------------------------------- ! This is the NUOPC cap for XOCN !---------------------------------------------------------------------------- + use ESMF use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise @@ -11,11 +12,8 @@ module ocn_comp_nuopc use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet - use med_constants_mod , only : IN, R8, I8, CXX, CL, CS - use med_constants_mod , only : shr_log_Unit + use med_constants_mod , only : R8, CL, CS use med_constants_mod , only : shr_file_getlogunit, shr_file_setlogunit - use med_constants_mod , only : shr_file_getloglevel, shr_file_setloglevel - use med_constants_mod , only : shr_file_setIO, shr_file_getUnit use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_scalars_mod , only : flds_scalar_num use shr_nuopc_scalars_mod , only : flds_scalar_index_nx @@ -23,14 +21,11 @@ module ocn_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_Clock_TimePrint use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_GetFldPtr - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_nuopc_grid_mod , only : shr_nuopc_grid_Meshinit + use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_ChkErr use dead_nuopc_mod , only : dead_grid_lat, dead_grid_lon, dead_grid_index - use dead_nuopc_mod , only : dead_init_nuopc, dead_run_nuopc, dead_final_nuopc + use dead_nuopc_mod , only : dead_init_nuopc, dead_final_nuopc, dead_meshinit use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - use dead_nuopc_mod , only : state_getimport, state_setexport - use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, Print_FieldExchInfo + use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock use med_constants_mod , only : dbug=> med_constants_dbug_flag implicit none @@ -46,12 +41,12 @@ module ocn_comp_nuopc integer :: fldsFrOcn_num = 0 type (fld_list_type) :: fldsToOcn(fldsMax) type (fld_list_type) :: fldsFrOcn(fldsMax) + integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost + real(r8), pointer :: gbuf(:,:) ! model info real(r8), pointer :: lat(:) real(r8), pointer :: lon(:) integer , allocatable :: gindex(:) - real(r8), allocatable :: x2d(:,:) - real(r8), allocatable :: d2x(:,:) integer :: nxg ! global dim i-direction integer :: nyg ! global dim j-direction integer :: my_task ! my task in mpi communicator mpicom @@ -60,55 +55,56 @@ module ocn_comp_nuopc character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") integer :: logunit ! logging unit number integer ,parameter :: master_task=0 ! task number of master task - logical :: mastertask - character(len=*),parameter :: grid_option = "mesh" ! grid_de, grid_arb, grid_reg, mesh + logical :: mastertask character(*),parameter :: modName = "(xocn_comp_nuopc)" character(*),parameter :: u_FILE_u = __FILE__ !=============================================================================== contains - !=============================================================================== +!=============================================================================== + subroutine SetServices(gcomp, rc) + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! switching to IPD versions call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & userRoutine=ModelInitPhase, phase=0, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! set entry point for methods that require specific implementation call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p1"/), & userRoutine=InitializeAdvertise, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p3"/), & userRoutine=InitializeRealize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! attach specializing method(s) call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, specRoutine=ModelAdvance, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end subroutine SetServices @@ -132,10 +128,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: n integer :: lsize ! local array size integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - logical :: isPresent - character(len=512) :: diro - character(len=512) :: logfile character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -147,10 +139,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localpet=my_task, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return mastertask = my_task == master_task @@ -165,7 +157,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit, shrloglev) + call shr_nuopc_set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit) !---------------------------------------------------------------------------- ! Initialize xocn @@ -181,7 +173,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) lat(:) = gbuf(:,dead_grid_lat) lon(:) = gbuf(:,dead_grid_lon) - !-------------------------------- ! advertise import and export fields !-------------------------------- @@ -199,13 +190,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" ) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" ) - do n = 1,fldsFrOcn_num - if(mastertask) write(logunit,*)'Advertising From Xocn ',trim(fldsFrOcn(n)%stdname) - call NUOPC_Advertise(exportState, standardName=fldsFrOcn(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - enddo - call fld_list_add(fldsToOcn_num, fldsToOcn, trim(flds_scalar_name)) call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" ) call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" ) @@ -225,15 +209,19 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" ) call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" ) + do n = 1,fldsFrOcn_num + if(mastertask) write(logunit,*)'Advertising From Xocn ',trim(fldsFrOcn(n)%stdname) + call NUOPC_Advertise(exportState, standardName=fldsFrOcn(n)%stdname, & + TransferOfferGeomObject='will provide', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo + do n = 1,fldsToOcn_num if(mastertask) write(logunit,*)'Advertising To Xocn',trim(fldsToOcn(n)%stdname) call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return enddo - - allocate(d2x(FldsFrOcn_num,lsize)); d2x(:,:) = 0._r8 - allocate(x2d(FldsToOcn_num,lsize)); x2d(:,:) = 0._r8 end if call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -242,7 +230,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Reset shr logging to original values !---------------------------------------------------------------------------- - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) end subroutine InitializeAdvertise @@ -261,7 +248,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) character(ESMF_MAXSTR) :: convCIM, purpComp type(ESMF_Mesh) :: Emesh integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level integer :: n character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize: xocn) ' !------------------------------------------------------------------------------- @@ -274,16 +260,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) !-------------------------------- ! generate the mesh !-------------------------------- - call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dead_meshinit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -299,7 +283,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':docnExport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call fld_list_realize( & state=importState, & @@ -309,27 +293,22 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':docnImport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Pack export state - ! Copy from d2x to exportState and set the coupling scalars !-------------------------------- - do n = 1, FldsFrOcn_num - if (fldsFrOcn(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrOcn(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do + call state_setexport(exportState, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics @@ -337,7 +316,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (dbug > 1) then call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return endif #ifdef USE_ESMF_METADATA @@ -353,7 +332,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_AttributeSet(comp, "ModelType", "Ocean", convention=convCIM, purpose=purpComp, rc=rc) #endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -372,44 +350,26 @@ subroutine ModelAdvance(gcomp, rc) ! local variables type(ESMF_Clock) :: clock type(ESMF_State) :: exportState - integer :: n integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - real(r8), pointer :: dataptr(:) character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call shr_nuopc_memcheck(subname, 3, mastertask) + call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) !-------------------------------- ! Pack export state !-------------------------------- - call dead_run_nuopc('ocn', d2x, gbuf) - call NUOPC_ModelGet(gcomp, modelClock=clock, exportState=exportState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1, FldsFrOcn_num - if (fldsFrOcn(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrOcn(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do - - ! reset So_omask - call shr_nuopc_methods_State_GetFldPtr(exportState, fldname='So_omask', fldptr1=dataptr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(dataptr) - !dataptr(n) = float(nint(min(1.0_R8,max(0.0_R8,dataptr(n))))) - dataptr(n) = 0._r8 - end do + call state_setexport(exportState, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics @@ -417,13 +377,12 @@ subroutine ModelAdvance(gcomp, rc) if (dbug > 1) then call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if(my_task == master_task) then call shr_nuopc_log_clock_advance(clock, 'OCN', logunit) endif endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -432,7 +391,98 @@ end subroutine ModelAdvance !=============================================================================== + subroutine state_setexport(exportState, rc) + + ! input/output variables + type(ESMF_State) , intent(inout) :: exportState + integer, intent(out) :: rc + + ! local variables + integer :: nf, nind + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Start from index 2 in order to Skip the scalar field here + do nf = 2,fldsFrOcn_num + if (fldsFrOcn(nf)%ungridded_ubound == 0) then + call field_setexport(exportState, trim(fldsFrOcn(nf)%stdname), lon, lat, nf=nf, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + do nind = 1,fldsFrOcn(nf)%ungridded_ubound + call field_setexport(exportState, trim(fldsFrOcn(nf)%stdname), lon, lat, nf=nf, & + ungridded_index=nind, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end do + end if + end do + + end subroutine state_setexport + + !=============================================================================== + + subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, rc) + + use shr_const_mod , only : pi=>shr_const_pi + + ! intput/otuput variables + type(ESMF_State) , intent(inout) :: exportState + character(len=*) , intent(in) :: fldname + real(r8) , intent(in) :: lon(:) + real(r8) , intent(in) :: lat(:) + integer , intent(in) :: nf + integer, optional , intent(in) :: ungridded_index + integer , intent(out) :: rc + + ! local variables + integer :: i, ncomp + type(ESMF_Field) :: lfield + real(r8), pointer :: data1d(:) + real(r8), pointer :: data2d(:,:) + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(exportState, itemName=trim(fldname), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ncomp = 4 + if (present(ungridded_index)) then + call ESMF_FieldGet(lfield, farrayPtr=data2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (gridToFieldMap == 1) then + do i = 1,size(data2d, dim=1) + data2d(i,ungridded_index) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + else if (gridToFieldMap == 2) then + do i = 1,size(data2d, dim=2) + data2d(ungridded_index,i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + end if + else + call ESMF_FieldGet(lfield, farrayPtr=data1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do i = 1,size(data1d) + data1d(i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + end if + + if (fldname == 'So_omask') then + do i = 1,size(data1d) + !data1d(i) = float(nint(min(1.0_R8,max(0.0_R8,data1d(i))))) + data1d(i) = 0._r8 + end do + end if + + end subroutine field_setexport + + !=============================================================================== + subroutine ModelFinalize(gcomp, rc) + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc diff --git a/src/components/xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 b/src/components/xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 index ceb885e07cad..d85bf0f1400d 100644 --- a/src/components/xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 @@ -3,6 +3,7 @@ module rof_comp_nuopc !---------------------------------------------------------------------------- ! This is the NUOPC cap for XROF !---------------------------------------------------------------------------- + use ESMF use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise @@ -11,11 +12,8 @@ module rof_comp_nuopc use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet - use med_constants_mod , only : IN, R8, I8, CXX, CL, CS - use med_constants_mod , only : shr_log_Unit + use med_constants_mod , only : R8, CL, CS use med_constants_mod , only : shr_file_getlogunit, shr_file_setlogunit - use med_constants_mod , only : shr_file_getloglevel, shr_file_setloglevel - use med_constants_mod , only : shr_file_setIO, shr_file_getUnit use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_scalars_mod , only : flds_scalar_num use shr_nuopc_scalars_mod , only : flds_scalar_index_nx @@ -23,13 +21,11 @@ module rof_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_Clock_TimePrint use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_nuopc_grid_mod , only : shr_nuopc_grid_Meshinit + use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_ChkErr use dead_nuopc_mod , only : dead_grid_lat, dead_grid_lon, dead_grid_index - use dead_nuopc_mod , only : dead_init_nuopc, dead_run_nuopc, dead_final_nuopc + use dead_nuopc_mod , only : dead_init_nuopc, dead_final_nuopc, dead_meshinit use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - use dead_nuopc_mod , only : state_getimport, state_setexport - use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, Print_FieldExchInfo + use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock use med_constants_mod , only : dbug => med_constants_dbug_flag implicit none @@ -45,12 +41,12 @@ module rof_comp_nuopc integer :: fldsFrRof_num = 0 type (fld_list_type) :: fldsToRof(fldsMax) type (fld_list_type) :: fldsFrRof(fldsMax) + integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost + real(r8), pointer :: gbuf(:,:) ! model info real(r8), pointer :: lat(:) real(r8), pointer :: lon(:) integer , allocatable :: gindex(:) - real(r8), allocatable :: x2d(:,:) - real(r8), allocatable :: d2x(:,:) integer :: nxg ! global dim i-direction integer :: nyg ! global dim j-direction integer :: my_task ! my task in mpi @@ -59,8 +55,7 @@ module rof_comp_nuopc character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") integer :: logunit ! logging unit number integer ,parameter :: master_task=0 ! task number of master task - logical :: mastertask - character(len=*),parameter :: grid_option = "mesh" ! grid_de, grid_arb, grid_reg, mesh + logical :: mastertask character(*),parameter :: modName = "(xrof_comp_nuopc)" character(*),parameter :: u_FILE_u = & __FILE__ @@ -68,53 +63,59 @@ module rof_comp_nuopc !=============================================================================== contains !=============================================================================== + subroutine SetServices(gcomp, rc) + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! switching to IPD versions call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & userRoutine=ModelInitPhase, phase=0, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! set entry point for methods that require specific implementation call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p1"/), & userRoutine=InitializeAdvertise, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p3"/), & userRoutine=InitializeRealize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! attach specializing method(s) call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, specRoutine=ModelAdvance, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end subroutine SetServices + !=============================================================================== + subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_set_component_logging use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance + type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -128,10 +129,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: lsize ! local array size integer :: ierr ! error code integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - logical :: isPresent - character(len=512) :: diro - character(len=512) :: logfile character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -139,10 +136,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localpet=my_task, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return mastertask = my_task == master_task @@ -157,7 +154,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit, shrloglev) + call shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit) !---------------------------------------------------------------------------- ! Initialize xrof @@ -187,13 +184,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrRof_num, fldsFrRof, 'Flrr_volr') call fld_list_add(fldsFrRof_num, fldsFrRof, 'Flrr_volrmch') - do n = 1,fldsFrRof_num - if(mastertask) write(logunit,*)'Advertising From Xrof ',trim(fldsFrRof(n)%stdname) - call NUOPC_Advertise(exportState, standardName=fldsFrRof(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - enddo - call fld_list_add(fldsToRof_num, fldsToRof, trim(flds_scalar_name)) call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_rofsur') call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_rofgwl') @@ -202,15 +192,19 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_rofi') call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_irrig') + do n = 1,fldsFrRof_num + if(mastertask) write(logunit,*)'Advertising From Xrof ',trim(fldsFrRof(n)%stdname) + call NUOPC_Advertise(exportState, standardName=fldsFrRof(n)%stdname, & + TransferOfferGeomObject='will provide', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo + do n = 1,fldsToRof_num if(mastertask) write(logunit,*)'Advertising To Xrof',trim(fldsToRof(n)%stdname) call NUOPC_Advertise(importState, standardName=fldsToRof(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return enddo - - allocate(d2x(FldsFrRof_num,lsize)); d2x(:,:) = 0._r8 - allocate(x2d(FldsToRof_num,lsize)); x2d(:,:) = 0._r8 end if if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -219,7 +213,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Reset shr logging to original values !---------------------------------------------------------------------------- - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) end subroutine InitializeAdvertise @@ -227,6 +220,7 @@ end subroutine InitializeAdvertise !=============================================================================== subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -236,7 +230,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) character(ESMF_MAXSTR) :: convCIM, purpComp type(ESMF_Mesh) :: Emesh integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level integer :: n character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' !------------------------------------------------------------------------------- @@ -249,16 +242,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logUnit) !-------------------------------- ! generate the mesh !-------------------------------- - call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dead_meshinit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -274,7 +265,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':drofExport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call fld_list_realize( & state=importState, & @@ -284,40 +275,30 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':drofImport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Pack export state - ! Copy from d2x to exportState - ! Set the coupling scalars !-------------------------------- - do n = 1, FldsFrRof_num - if (fldsFrRof(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrRof(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do + call state_setexport(exportState, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics !-------------------------------- if (dbug > 1) then - if (mastertask) then - call Print_FieldExchInfo(values=d2x, logunit=logunit, & - fldlist=fldsFrRof, nflds=fldsFrRof_num, istr="InitializeRealize: rof->mediator") - end if call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return endif #ifdef USE_ESMF_METADATA @@ -333,7 +314,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_AttributeSet(comp, "ModelType", "River", convention=convCIM, purpose=purpComp, rc=rc) #endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -343,6 +323,7 @@ end subroutine InitializeRealize !=============================================================================== subroutine ModelAdvance(gcomp, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_memcheck, shr_nuopc_log_clock_advance ! input/output variables @@ -352,18 +333,15 @@ subroutine ModelAdvance(gcomp, rc) ! local variables type(ESMF_Clock) :: clock type(ESMF_State) :: exportState - integer :: n integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call shr_nuopc_memcheck(subname, 3, mastertask) + call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) !-------------------------------- @@ -371,16 +349,10 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call NUOPC_ModelGet(gcomp, modelClock=clock, exportState=exportState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call dead_run_nuopc('rof', d2x, gbuf) + if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1, FldsFrRof_num - if (fldsFrRof(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrRof(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do + call state_setexport(exportState, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics @@ -388,13 +360,12 @@ subroutine ModelAdvance(gcomp, rc) if (dbug > 1) then call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (mastertask) then call shr_nuopc_log_clock_advance(clock, 'ROF', logunit) endif endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -403,6 +374,86 @@ end subroutine ModelAdvance !=============================================================================== + subroutine state_setexport(exportState, rc) + + ! input/output variables + type(ESMF_State) , intent(inout) :: exportState + integer, intent(out) :: rc + + ! local variables + integer :: nf, nind + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Start from index 2 in order to skip the scalar field + do nf = 2,fldsFrRof_num + if (fldsFrRof(nf)%ungridded_ubound == 0) then + call field_setexport(exportState, trim(fldsFrRof(nf)%stdname), lon, lat, nf=nf, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + do nind = 1,fldsFrRof(nf)%ungridded_ubound + call field_setexport(exportState, trim(fldsFrRof(nf)%stdname), lon, lat, nf=nf+nind-1, & + ungridded_index=nind, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end do + end if + end do + + end subroutine state_setexport + + !=============================================================================== + + subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, rc) + + use shr_const_mod , only : pi=>shr_const_pi + + ! intput/otuput variables + type(ESMF_State) , intent(inout) :: exportState + character(len=*) , intent(in) :: fldname + real(r8) , intent(in) :: lon(:) + real(r8) , intent(in) :: lat(:) + integer , intent(in) :: nf + integer, optional , intent(in) :: ungridded_index + integer , intent(out) :: rc + + ! local variables + integer :: i, ncomp + type(ESMF_Field) :: lfield + real(r8), pointer :: data1d(:) + real(r8), pointer :: data2d(:,:) + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(exportState, itemName=trim(fldname), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ncomp = 6 + if (present(ungridded_index)) then + call ESMF_FieldGet(lfield, farrayPtr=data2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (gridToFieldMap == 1) then + do i = 1,size(data2d, dim=1) + data2d(i,ungridded_index) = (nf+1) * 1.0_r8 + end do + else if (gridToFieldMap == 2) then + do i = 1,size(data2d, dim=2) + data2d(ungridded_index,i) = (nf+1) * 1.0_r8 + end do + end if + else + call ESMF_FieldGet(lfield, farrayPtr=data1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do i = 1,size(data1d) + data1d(i) = (nf+1) * 1.0_r8 + end do + end if + + end subroutine field_setexport + + !=============================================================================== + subroutine ModelFinalize(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc diff --git a/src/components/xcpl_comps/xshare/nuopc/dead_nuopc_mod.F90 b/src/components/xcpl_comps/xshare/nuopc/dead_nuopc_mod.F90 index cb92e88c6a3b..8872275aad2a 100644 --- a/src/components/xcpl_comps/xshare/nuopc/dead_nuopc_mod.F90 +++ b/src/components/xcpl_comps/xshare/nuopc/dead_nuopc_mod.F90 @@ -1,32 +1,26 @@ module dead_nuopc_mod - use ESMF , only : ESMF_Gridcomp, ESMF_State, ESMF_StateGet - use ESMF , only : ESMF_Clock, ESMF_Time, ESMF_TimeInterval, ESMF_Alarm - use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_ClockSet, ESMF_ClockAdvance, ESMF_AlarmSet - use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_METHOD_INITIALIZE - use ESMF , only : ESMF_STATEITEM_NOTFOUND, ESMF_StateItem_Flag - use ESMF , only : ESMF_FIELDSTATUS_COMPLETE, ESMF_FAILURE - use ESMF , only : operator(/=), operator(==), operator(+) - use med_constants_mod , only : IN, R8, CS, CL - use shr_file_mod , only : shr_file_getunit, shr_file_freeunit - use shr_sys_mod , only : shr_sys_abort - use shr_nuopc_utils_mod , only : shr_nuopc_utils_ChkErr + use med_constants_mod , only : R8, CL + use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_ChkErr + use shr_sys_mod , only : shr_sys_abort + use ESMF , only : ESMF_Gridcomp, ESMF_State, ESMF_StateGet + use ESMF , only : ESMF_Clock, ESMF_Time, ESMF_TimeInterval, ESMF_Alarm + use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_ClockSet, ESMF_ClockAdvance, ESMF_AlarmSet + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_METHOD_INITIALIZE + use ESMF , only : ESMF_FAILURE + use ESMF , only : operator(/=), operator(==), operator(+) + implicit none private public :: dead_init_nuopc - public :: dead_run_nuopc public :: dead_final_nuopc + public :: dead_meshinit public :: ModelInitPhase public :: ModelSetRunClock public :: fld_list_add public :: fld_list_realize - public :: state_getimport - public :: state_setexport - public :: Print_FieldExchInfo - - private :: state_getfldptr ! !PUBLIC DATA MEMBERS: integer, public :: dead_grid_lat = 1 ! lat from component @@ -34,13 +28,13 @@ module dead_nuopc_mod integer, public :: dead_grid_area = 3 ! area from component integer, public :: dead_grid_mask = 4 ! mask, 0 = inactive cell integer, public :: dead_grid_frac = 5 ! fractional area coverage - integer, public :: dead_grid_aream = 6 ! area from mapping file - integer, public :: dead_grid_index = 7 ! global index - integer, public :: dead_grid_pid = 8 ! proc id number - integer, public :: dead_grid_total = 8 + integer, public :: dead_grid_index = 6 ! global index + integer, public :: dead_grid_total = 6 type fld_list_type character(len=128) :: stdname + integer :: ungridded_lbound = 0 + integer :: ungridded_ubound = 0 end type fld_list_type public :: fld_list_type @@ -54,32 +48,28 @@ module dead_nuopc_mod !=============================================================================== subroutine dead_read_inparms(model, inst_suffix, logunit, & - nxg, nyg, decomp_type, nproc_x, seg_len, flood) + nxg, nyg, decomp_type, nproc_x, seg_len) use ESMF, only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMBroadcast, ESMF_VMGet - ! input/output varialbes + ! input/output variables character(len=*) , intent(in) :: model character(len=*) , intent(in) :: inst_suffix ! char string associated with instance - integer(IN) , intent(in) :: logunit ! logging unit number - integer(IN) , intent(out) :: nproc_x - integer(IN) , intent(out) :: seg_len - integer(IN) , intent(out) :: nxg ! global dim i-direction - integer(IN) , intent(out) :: nyg ! global dim j-direction - integer(IN) , intent(out) :: decomp_type ! decomposition type - logical , intent(out) :: flood ! rof flood flag + integer , intent(in) :: logunit ! logging unit number + integer , intent(out) :: nproc_x + integer , intent(out) :: seg_len + integer , intent(out) :: nxg ! global dim i-direction + integer , intent(out) :: nyg ! global dim j-direction + integer , intent(out) :: decomp_type ! decomposition type ! local variables - type(ESMF_VM) :: vm - character(CL) :: fileName ! generic file name - integer(IN) :: nunit ! unit number - integer(IN) :: ierr ! error code - integer(IN) :: unitn ! Unit for namelist file - integer(IN) :: tmp(6) ! array for broadcast - integer(IN) :: localPet ! mpi id of current task in current context - integer :: rc ! EMSF return code - - ! formats + type(ESMF_VM) :: vm + character(CL) :: fileName ! generic file name + integer :: nunit ! unit number + integer :: unitn ! Unit for namelist file + integer :: tmp(5) ! array for broadcast + integer :: localPet ! mpi id of current task in current context + integer :: rc ! return code character(*), parameter :: F00 = "('(dead_read_inparms) ',8a)" character(*), parameter :: F01 = "('(dead_read_inparms) ',a,a,4i8)" character(*), parameter :: F03 = "('(dead_read_inparms) ',a,a,i8,a)" @@ -92,27 +82,20 @@ subroutine dead_read_inparms(model, inst_suffix, logunit, & nproc_x = -9999 seg_len = -9999 decomp_type = -9999 - flood = .false. call ESMF_VMGetCurrent(vm, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localPet=localPet, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - + if (chkerr(rc,__LINE__,u_FILE_u)) return if (localPet==0) then - unitn = shr_file_getUnit() - open(unitn, file='x'//model//'_in'//trim(inst_suffix), status='old' ) + open(newunit=unitn, file='x'//model//'_in'//trim(inst_suffix), status='old' ) read(unitn,*) nxg read(unitn,*) nyg read(unitn,*) decomp_type read(unitn,*) nproc_x read(unitn,*) seg_len - if (model.eq.'rof') then - read(unitn,*) flood - end if close (unitn) - call shr_file_freeunit(unitn) endif tmp(1) = nxg @@ -120,20 +103,14 @@ subroutine dead_read_inparms(model, inst_suffix, logunit, & tmp(3) = decomp_type tmp(4) = nproc_x tmp(5) = seg_len - if (model.eq.'rof' .and. flood) then - tmp(6) = 1 - else - tmp(6) = 0 - endif + call ESMF_VMBroadcast(vm, tmp, 6, 0, rc=rc) - nxg = tmp(1) - nyg = tmp(2) + + nxg = tmp(1) + nyg = tmp(2) decomp_type = tmp(3) - nproc_x = tmp(4) - seg_len = tmp(5) - if(tmp(6) == 1) then - flood = .true. - endif + nproc_x = tmp(4) + seg_len = tmp(5) if (localPet==0) then write(logunit,*)' Read in X'//model//' input from file= x'//model//'_in' @@ -145,67 +122,59 @@ subroutine dead_read_inparms(model, inst_suffix, logunit, & write(logunit,F03) model,' Num pes in X : ',nproc_x,' (type 3 only)' write(logunit,F03) model,' Segment Length : ',seg_len,' (type 11 only)' write(logunit,F00) model,' inst_suffix : ',trim(inst_suffix) - if (model.eq.'rof') then - write(logunit,F01) ' Flood mode : ',flood - endif write(logunit,F00) model end if + end subroutine dead_read_inparms !=============================================================================== subroutine dead_setNewGrid(decomp_type, nxg, nyg, logunit, lsize, gbuf, seg_len, nproc_x) - use ESMF , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VmGet - use shr_const_mod , only : shr_const_pi, shr_const_rearth - ! This sets up some defaults. The user may want to overwrite some ! of these fields in the main program after initialization in complete. + use ESMF , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VmGet + use shr_const_mod , only : shr_const_pi, shr_const_rearth + ! input/output parameters: - integer(IN) ,intent(in) :: decomp_type ! - integer(IN) ,intent(in) :: nxg,nyg ! global grid sizes - integer(IN) ,intent(in) :: logunit ! output logunit - integer(IN) ,intent(out) :: lsize ! local grid sizes - real(R8) ,pointer :: gbuf(:,:) ! output data - integer(IN) ,intent(in),optional :: seg_len ! seg len decomp setting - integer(IN) ,intent(in),optional :: nproc_x ! 2d decomp setting + integer , intent(in) :: decomp_type ! + integer , intent(in) :: nxg,nyg ! global grid sizes + integer , intent(in) :: logunit ! output logunit + integer , intent(out) :: lsize ! local grid sizes + real(R8), pointer :: gbuf(:,:) ! output data + integer , intent(in),optional :: seg_len ! seg len decomp setting + integer , intent(in),optional :: nproc_x ! 2d decomp setting ! local - type(ESMF_VM) :: vm - integer(IN) :: rc - integer(IN) :: mype - integer(IN) :: totpe ! total number of pes - integer(IN) :: ierr ! error code - logical :: found - integer(IN) :: i,j,ig,jg - integer(IN) :: n,ng,is,ie,js,je,nx,ny ! indices - integer(IN) :: npesx,npesy,mypex,mypey,nxp,nyp - real (R8) :: hscore,bscore - real (R8) :: dx,dy,deg2rad,ys,yc,yn,area,re - integer(IN),allocatable :: gindex(:) - - ! formats + type(ESMF_VM) :: vm + integer :: rc + integer :: mype + integer :: totpe ! total number of pes + logical :: found + integer :: i,j,ig,jg + integer :: n,ng,is,ie,js,je,nx,ny + integer :: npesx,npesy,mypex,mypey,nxp,nyp + real(R8) :: hscore,bscore + real(R8) :: dx,dy,deg2rad,ys,yc,yn,area,re + integer, allocatable :: gindex(:) character(*), parameter :: F00 = "('(dead_setNewGrid) ',8a)" character(*), parameter :: F01 = "('(dead_setNewGrid) ',a,4i8)" character(*), parameter :: subName = "(dead_setNewGrid) " !------------------------------------------------------------------------------- call ESMF_VMGetCurrent(vm, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localPet=mype, peCount=totpe, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return - if (decomp_type == 1 .or. & + if ( decomp_type == 1 .or. & decomp_type == 2 .or. & decomp_type == 3 .or. & decomp_type == 4 .or. & decomp_type == 11) then - ! valid else - !------------------------------------------------------------------------- ! invalid decomposition type - !------------------------------------------------------------------------- if (mype == 0) then write(logunit,F01) 'ERROR: invalid decomp_type = ',decomp_type end if @@ -215,7 +184,6 @@ subroutine dead_setNewGrid(decomp_type, nxg, nyg, logunit, lsize, gbuf, seg_len, if (nxg*nyg == 0) then lsize = 0 allocate(gbuf(lsize,dead_grid_total)) - ! gbuf = -888.0_R8 if (mype == 0) then write(logunit,*) subname,' grid size is zero, lsize = ',lsize end if @@ -404,134 +372,46 @@ subroutine dead_init_nuopc(model, inst_suffix, logunit, lsize, gbuf, nxg, nyg) integer , intent(out) :: nyg ! global dim j-direction !--- local variables --- - integer :: ierr ! error code integer :: local_comm ! local communicator - integer :: mype ! pe info - integer :: totpe ! total number of pes integer :: nproc_x integer :: seg_len integer :: decomp_type - logical :: flood=.false. ! rof flood flag character(*), parameter :: subName = "(dead_init_nuopc) " !------------------------------------------------------------------------------- ! Read input parms - call dead_read_inparms(model, inst_suffix, logunit, & - nxg, nyg, decomp_type, nproc_x, seg_len, flood) + call dead_read_inparms(model, inst_suffix, logunit, nxg, nyg, decomp_type, nproc_x, seg_len) ! Initialize grid - call dead_setNewGrid(decomp_type, nxg, nyg, logunit, & - lsize, gbuf, seg_len, nproc_x) + call dead_setNewGrid(decomp_type, nxg, nyg, logunit, lsize, gbuf, seg_len, nproc_x) end subroutine dead_init_nuopc !=============================================================================== - subroutine dead_run_nuopc(model, d2x, gbuf) - - use shr_const_mod , only : shr_const_pi - - ! run method for dead model - - ! input/output parameters: - character(len=*) , intent(in) :: model - real(r8) , intent(inout) :: d2x(:,:) ! dead -> driver - real(r8) , pointer :: gbuf(:,:) ! model grid - - ! local - integer :: n ! index - integer :: nf ! fields loop index - integer :: ki ! index - integer :: lsize ! size of AttrVect - real(R8) :: lat ! latitude - real(R8) :: lon ! longitude - integer :: nflds_d2x - integer :: ncomp - character(*), parameter :: subName = "(dead_run_nuopc) " - !------------------------------------------------------------------------------- - - selectcase(model) - case('atm') - ncomp = 1 - case('lnd') - ncomp = 2 - case('ice') - ncomp = 3 - case('ocn') - ncomp = 4 - case('glc') - ncomp = 5 - case('rof') - ncomp = 6 - case('wav') - ncomp = 7 - end select - - nflds_d2x = size(d2x, dim=1) - lsize = size(d2x, dim=2) - - if (model.eq.'rof') then - do nf=1,nflds_d2x - do n=1,lsize - d2x(nf,n) = (nf+1) * 1.0_r8 - enddo - enddo - else if (model.eq.'glc') then - do nf=1,nflds_d2x - do n=1,lsize - lon = gbuf(n,dead_grid_lon) - lat = gbuf(n,dead_grid_lat) - d2x(nf,n) = (nf*100) & - * cos (SHR_CONST_PI*lat/180.0_R8) & - * cos (SHR_CONST_PI*lat/180.0_R8) & - * sin (SHR_CONST_PI*lon/180.0_R8) & - * sin (SHR_CONST_PI*lon/180.0_R8) & - + (ncomp*10.0_R8) - enddo - enddo - else - do nf=1,nflds_d2x - do n=1,lsize - lon = gbuf(n,dead_grid_lon) - lat = gbuf(n,dead_grid_lat) - d2x(nf,n) = (nf*100) & - * cos (SHR_CONST_PI*lat/180.0_R8) & - * sin((SHR_CONST_PI*lon/180.0_R8) & - - (ncomp-1)*(SHR_CONST_PI/3.0_R8) ) & - + (ncomp*10.0_R8) - enddo - enddo - endif - - end subroutine dead_run_nuopc - - !=============================================================================== - subroutine dead_final_nuopc(model, logunit) - use ESMF, only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet - ! finalize method for xcpl component + use ESMF, only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet + ! input/output parameters: character(len=*) , intent(in) :: model integer , intent(in) :: logunit ! logging unit number - !-- local -- + ! local variables type(ESMF_VM) :: vm - integer :: rc - integer :: localPet - - !--- formats --- + integer :: rc + integer :: localPet character(*), parameter :: F00 = "('(dead_comp_final) ',8a)" character(*), parameter :: F91 = "('(dead_comp_final) ',73('-'))" character(*), parameter :: subName = "(dead_comp_final) " !------------------------------------------------------------------------------- call ESMF_VMGetCurrent(vm, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localPet=localPet, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (localPet==0) then write(logunit,F91) @@ -543,17 +423,18 @@ end subroutine dead_final_nuopc !=============================================================================== - subroutine fld_list_add(num, fldlist, stdname) + subroutine fld_list_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound) use ESMF, only : ESMF_LogWrite, ESMF_LOGMSG_ERROR - integer, intent(inout) :: num - type(fld_list_type), intent(inout) :: fldlist(:) - character(len=*), intent(in) :: stdname + ! input/output variables + integer , intent(inout) :: num + type(fld_list_type) , intent(inout) :: fldlist(:) + character(len=*) , intent(in) :: stdname + integer, optional , intent(in) :: ungridded_lbound + integer, optional , intent(in) :: ungridded_ubound ! local variables - integer :: rc - integer :: dbrc character(len=*), parameter :: subname='(dead_nuopc_mod:fld_list_add)' !------------------------------------------------------------------------------- @@ -561,11 +442,16 @@ subroutine fld_list_add(num, fldlist, stdname) 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) + 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 + end subroutine fld_list_add !=============================================================================== @@ -588,10 +474,10 @@ subroutine fld_list_realize(state, fldList, numflds, flds_scalar_name, flds_scal integer , intent(inout) :: rc ! local variables - integer :: dbrc - integer :: n - type(ESMF_Field) :: field - character(len=80) :: stdname + integer :: n + type(ESMF_Field) :: field + character(len=80) :: stdname + integer :: gridtoFieldMap=2 character(len=*),parameter :: subname='(dshr_nuopc_mod:fld_list_realize)' ! ---------------------------------------------- @@ -602,16 +488,24 @@ subroutine fld_list_realize(state, fldList, numflds, flds_scalar_name, flds_scal if (NUOPC_IsConnected(state, fieldName=stdname)) then if (stdname == trim(flds_scalar_name)) then call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected on root pe", & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) ! Create the scalar field call SetScalarField(field, flds_scalar_name, flds_scalar_num, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return else call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected using mesh", & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) ! Create the field - field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (fldlist(n)%ungridded_lbound > 0 .and. fldlist(n)%ungridded_ubound > 0) then + field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, & + ungriddedLbound=(/fldlist(n)%ungridded_lbound/), & + ungriddedUbound=(/fldlist(n)%ungridded_ubound/), & + gridToFieldMap=(/gridToFieldMap/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + end if endif ! NOW call NUOPC_Realize @@ -620,7 +514,7 @@ subroutine fld_list_realize(state, fldList, numflds, flds_scalar_name, flds_scal else if (stdname /= trim(flds_scalar_name)) then call ESMF_LogWrite(subname // trim(tag) // " Field = "// trim(stdname) // " is not connected.", & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) call ESMF_StateRemove(state, (/stdname/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return end if @@ -633,6 +527,7 @@ subroutine SetScalarField(field, flds_scalar_name, flds_scalar_num, rc) ! ---------------------------------------------- ! create a field with scalar data on the root pe ! ---------------------------------------------- + use ESMF, only : ESMF_Field, ESMF_DistGrid, ESMF_Grid use ESMF, only : ESMF_DistGridCreate, ESMF_GridCreate, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU use ESMF, only : ESMF_FieldCreate, ESMF_GridCreate, ESMF_TYPEKIND_R8 @@ -658,7 +553,7 @@ subroutine SetScalarField(field, flds_scalar_name, flds_scalar_num, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return field = ESMF_FieldCreate(name=trim(flds_scalar_name), grid=grid, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), ungriddedUBound=(/flds_scalar_num/), rc=rc) + ungriddedLBound=(/1/), ungriddedUBound=(/flds_scalar_num/), gridToFieldMap=(/2/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return end subroutine SetScalarField @@ -681,7 +576,7 @@ subroutine ModelInitPhase(gcomp, importState, exportState, clock, rc) ! Switch to IPDv01 by filtering all other phaseMap entries call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, acceptStringList=(/"IPDv01p"/), rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end subroutine ModelInitPhase @@ -694,6 +589,7 @@ subroutine ModelSetRunClock(gcomp, rc) use NUOPC_Model , only : NUOPC_ModelGet use NUOPC , only : NUOPC_CompAttributeGet + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -707,24 +603,23 @@ subroutine ModelSetRunClock(gcomp, rc) integer :: restart_n ! Number until restart interval integer :: restart_ymd ! Restart date (YYYYMMDD) type(ESMF_ALARM) :: restart_alarm - integer :: dbrc character(len=128) :: name integer :: alarmcount character(len=*),parameter :: subname='dshr_nuopc_mod:(ModelSetRunClock) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug_flag > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! query the Component for its clocks call NUOPC_ModelGet(gcomp, driverClock=dclock, modelClock=mclock, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet(dclock, currTime=dcurrtime, timeStep=dtimestep, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet(mclock, currTime=mcurrtime, timeStep=mtimestep, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! force model clock currtime and timestep to match driver and set stoptime @@ -732,30 +627,30 @@ subroutine ModelSetRunClock(gcomp, rc) mstoptime = mcurrtime + dtimestep call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! set restart alarm !-------------------------------- call ESMF_ClockGetAlarmList(mclock, alarmlistflag=ESMF_ALARMLIST_ALL, alarmCount=alarmCount, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (alarmCount == 0) then call ESMF_GridCompGet(gcomp, name=name, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//'setting alarms for' // trim(name), ESMF_LOGMSG_INFO, rc=dbrc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//'setting alarms for' // trim(name), ESMF_LOGMSG_INFO) call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) restart_n call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) restart_ymd call shr_nuopc_time_alarmInit(mclock, restart_alarm, restart_option, & @@ -763,10 +658,10 @@ subroutine ModelSetRunClock(gcomp, rc) opt_ymd = restart_ymd, & RefTime = mcurrTime, & alarmname = 'alarm_restart', rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end if @@ -775,208 +670,246 @@ subroutine ModelSetRunClock(gcomp, rc) !-------------------------------- call ESMF_ClockAdvance(mclock,rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug_flag > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine ModelSetRunClock !=============================================================================== - - subroutine state_getimport(state, fldname, output, rc) - - ! ---------------------------------------------- - ! Map import state field to output array - ! ---------------------------------------------- - - ! input/output variables - type(ESMF_State) , intent(in) :: state - character(len=*) , intent(in) :: fldname - real(r8) , intent(out) :: output(:) - integer , intent(out) :: rc + + subroutine dead_meshinit(gcomp, nx_global, ny_global, gindex, lon, lat, Emesh, rc) + + !----------------------------------------- + ! create an Emesh object for Fields + !----------------------------------------- + + use shr_kind_mod , only : R8=>shr_kind_r8 + use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_Mesh + use ESMF , only : ESMF_VMGet, ESMF_GridCompGet, ESMF_VMBroadCast, ESMF_VMAllGatherV + use ESMF , only : ESMF_SUCCESS, ESMF_LOGMSG_INFO, ESMF_LogWrite + use ESMF , only : ESMF_VMGather, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU + use ESMF , only : ESMF_MeshCreate, ESMF_COORDSYS_SPH_DEG, ESMF_REDUCE_SUM + use ESMF , only : ESMF_VMAllReduce, ESMF_MESHELEMTYPE_QUAD + + ! input/output arguments + type(ESMF_GridComp) :: gcomp + integer , intent(in) :: nx_global + integer , intent(in) :: ny_global + integer , intent(in) :: gindex(:) + real(r8), pointer , intent(in) :: lon(:) + real(r8), pointer , intent(in) :: lat(:) + type(ESMF_Mesh) , intent(inout) :: Emesh + integer , intent(inout) :: rc ! local variables - integer :: g, i - real(R8), pointer :: fldptr(:) - type(ESMF_StateItem_Flag) :: itemFlag - integer :: dbrc - character(len=*), parameter :: subname='(lnd_import_export:state_getimport)' - ! ---------------------------------------------- + integer :: n,n1,n2,de + integer :: iam + integer :: lsize + integer :: numTotElems, numNodes, numConn, nodeindx + integer :: iur,iul,ill,ilr + integer :: xid, yid, xid0, yid0 + real(r8) :: lonur, lonul, lonll, lonlr + integer, pointer :: iurpts(:) + integer, pointer :: elemIds(:) + integer, pointer :: elemTypes(:) + integer, pointer :: elemConn(:) + real(r8),pointer :: elemCoords(:) + integer, pointer :: nodeIds(:) + integer, pointer :: nodeOwners(:) + real(r8),pointer :: nodeCoords(:) + real(r8),pointer :: latG(:) + real(r8),pointer :: lonG(:) + integer ,pointer :: pes_local(:) + integer ,pointer :: pes_global(:) + integer, pointer :: recvOffsets(:) + integer, pointer :: recvCounts(:) + integer :: sendData(1) + type(ESMF_VM) :: vm + integer :: petCount + character(len=*),parameter :: subname='(shr_nuopc_grid_MeshInit)' + !-------------------------------------------------------------- rc = ESMF_SUCCESS - ! Determine if field with name fldname exists in state - call ESMF_StateGet(state, trim(fldname), itemFlag, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - - ! if field exists then create output array - else do nothing - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - - ! get field pointer - call state_getfldptr(state, trim(fldname), fldptr, rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - ! determine output array - do g = 1,size(fldptr) - output(g) = fldptr(g) - end do - end if - - end subroutine state_getimport - - !=============================================================================== - - subroutine state_setexport(state, fldname, input, rc) - ! ---------------------------------------------- - ! Map input array to export state field - ! ---------------------------------------------- + lsize = size(gindex) - ! input/output variables - type(ESMF_State) , intent(inout) :: state - character(len=*) , intent(in) :: fldname - real(r8) , intent(in) :: input(:) - integer , intent(out) :: rc + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - ! local variables - integer :: g, i - real(R8), pointer :: fldptr(:) - type(ESMF_StateItem_Flag) :: itemFlag - integer :: dbrc - character(len=*), parameter :: subname='(lnd_import_export:state_setexport)' - ! ---------------------------------------------- + call ESMF_VMGet(vm, petCount=petCount, localpet=iam, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - rc = ESMF_SUCCESS - - ! Determine if field with name fldname exists in state - call ESMF_StateGet(state, trim(fldname), itemFlag, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(latG(nx_global*ny_global)) + allocate(lonG(nx_global*ny_global)) - ! if field exists then create output array - else do nothing - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then + allocate(recvoffsets(petCount)) + allocate(recvCounts(petCount)) - ! get field pointer - call state_getfldptr(state, trim(fldname), fldptr, rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + sendData(1) = lsize + call ESMF_VMGather(vm, sendData=sendData, recvData=recvCounts, count=1, rootPet=0, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - ! set fldptr values to input array - do g = 1,size(fldptr) - fldptr(g) = input(g) - end do - end if + call ESMF_VMBroadCast(vm, bcstData=recvCounts, count=petCount, rootPet=0, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - end subroutine state_setexport + recvoffsets(1) = 0 + do n = 2,petCount + recvoffsets(n) = recvoffsets(n-1) + recvCounts(n-1) + end do - !=============================================================================== + call ESMF_VMAllGatherV(vm, lat, lsize, latG, recvCounts, recvOffsets, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMAllGatherV(vm, lon, lsize, lonG, recvCounts, recvOffsets, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + deallocate(recvoffsets) + deallocate(recvCounts) + + ! assumes quadrilaterals for each gridcell (element) + ! element index matches gsmap index value + ! nodeid at lower left of each gridcell matches gsmap index value + ! assumes wrap around in x direction but no wrap in y direction + ! node ids need to be described in counter clockwise direction + ! node id associated with lower left cell is assigned to local PET + ! node ids at top of y boundary assigned to the element to the right + + numTotElems = lsize + + allocate(elemIds(numTotElems)) + allocate(elemTypes(numTotElems)) + elemTypes=(/ESMF_MESHELEMTYPE_QUAD/) + allocate(elemConn(4*numTotElems)) + allocate(elemCoords(2*numTotElems)) + + allocate(nodeIds(numTotElems*4)) + nodeIds = -99 + + elemIds(:) = gindex(:) + numNodes = 0 + numConn = 0 + + do n = 1,numTotElems + elemTypes(n) = ESMF_MESHELEMTYPE_QUAD + elemCoords(2*n-1) = lon(n) + elemCoords(2*n) = lat(n) + + do n1 = 1,4 + + numNodes = numNodes + 1 + nodeindx = numNodes + if (n1 == 1 .or. n1 == 3) xid = mod(elemIds(n)-1,nx_global) + 1 + if (n1 == 2 .or. n1 == 4) xid = mod(elemIds(n) ,nx_global) + 1 + if (n1 == 1 .or. n1 == 2) yid = (elemIds(n)-1)/nx_global + 1 + if (n1 == 3 .or. n1 == 4) yid = (elemIds(n)-1)/nx_global + 2 + nodeIds(numNodes) = (yid-1) * nx_global + xid + n2 = 0 + do while (n2 < numNodes - 1 .and. nodeindx == numNodes) + n2 = n2 + 1 + if (nodeIds(numNodes) == nodeIds(n2)) nodeindx = n2 + enddo + if (nodeindx /= numNodes) then + numNodes = numNodes - 1 + endif - subroutine state_getfldptr(State, fldname, fldptr, rc) - ! ---------------------------------------------- - ! Get pointer to a state field - ! ---------------------------------------------- - use ESMF , only : ESMF_State, ESMF_Field, ESMF_Mesh, ESMF_FieldStatus_Flag - use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_MeshGet - use ESMF , only : ESMF_FIELDSTATUS_COMPLETE, ESMF_FAILURE + numConn = numConn + 1 + elemConn(numConn) = nodeindx + enddo + enddo - type(ESMF_State), intent(in) :: State - character(len=*), intent(in) :: fldname - real(R8), pointer, intent(out) :: fldptr(:) - integer, intent(out) :: rc - ! local variables - type(ESMF_FieldStatus_Flag) :: status - type(ESMF_Field) :: lfield - type(ESMF_Mesh) :: lmesh - integer :: dbrc - integer :: nnodes, nelements - character(len=*), parameter :: subname='(lnd_import_export:state_getfldptr)' - ! ---------------------------------------------- + allocate(nodeCoords(2*numNodes)) + allocate(nodeOwners(numNodes)) + allocate(iurpts(numNodes)) - rc = ESMF_SUCCESS + do n = 1,numNodes - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + xid0 = mod(nodeIds(n)-1, nx_global) + 1 + yid0 = (nodeIds(n)-1) / nx_global + 1 - call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + xid = xid0 + yid = max(min(yid0,ny_global),1) + iur = (yid-1) * nx_global + xid + iurpts(n) = iur - call ESMF_FieldGet(lfield, status=status, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + xid = mod(xid0 - 2 + nx_global, nx_global) + 1 + yid = max(min(yid0,ny_global),1) + iul = (yid-1) * nx_global + xid - 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 (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + xid = mod(xid0 - 2 + nx_global, nx_global) + 1 + yid = max(min(yid0-1,ny_global),1) + ill = (yid-1) * nx_global + xid - call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + xid = xid0 + yid = max(min(yid0-1,ny_global),1) + ilr = (yid-1) * nx_global + xid - if (nnodes == 0 .and. nelements == 0) then - call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", ESMF_LOGMSG_INFO, rc=dbrc) - rc = ESMF_FAILURE - return - end if - - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - endif ! status + ! write(tmpstr,'(2a,8i6)') subname,' nodecoord = ',n,nodeIds(n),xid0,yid0,iur,iul,ill,ilr + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif + ! need to normalize lon values to same 360 degree setting, use lonur as reference value + lonur = lonG(iur) + lonul = lonG(iul) + lonll = lonG(ill) + lonlr = lonG(ilr) - end subroutine state_getfldptr + if (abs(lonul + 360._r8 - lonur) < abs(lonul - lonur)) lonul = lonul + 360._r8 + if (abs(lonul - 360._r8 - lonur) < abs(lonul - lonur)) lonul = lonul - 360._r8 + if (abs(lonll + 360._r8 - lonur) < abs(lonll - lonur)) lonll = lonll + 360._r8 + if (abs(lonll - 360._r8 - lonur) < abs(lonll - lonur)) lonll = lonll - 360._r8 + if (abs(lonlr + 360._r8 - lonur) < abs(lonlr - lonur)) lonlr = lonlr + 360._r8 + if (abs(lonlr - 360._r8 - lonur) < abs(lonlr - lonur)) lonlr = lonlr - 360._r8 - !=============================================================================== - - subroutine Print_FieldExchInfo(values, logunit, fldlist, nflds, istr) - - use med_constants_mod , only : R8 - use ESMF , only : ESMF_MAXSTR + nodeCoords(2*n-1) = 0.25_r8 * (lonur + lonul + lonll + lonlr) + nodeCoords(2*n) = 0.25_r8 * (latG(iur) + latG(iul) + latG(ill) + latG(ilr)) + enddo - ! !DESCRIPTION: - ! Print out information about values to stdount - ! - flag sets the level of information: - ! - print out names of fields in values 2d array - ! - also print out local max and min of data in values 2d array - ! If optional argument istr is present, it will be output before any of the information. + deallocate(lonG) + deallocate(latG) + ! Determine the pes that own each index of iurpts (nodeOwners) - ! input/output parameters: - real(R8) , intent(in) :: values(:,:) ! arrays sent to/recieved from mediator - integer , intent(in) :: logunit - type(fld_list_type) , intent(in) :: fldlist(:) - integer , intent(in) :: nflds - character(*) , intent(in),optional :: istr ! string for print - - !--- local --- - integer :: n ! generic indicies - integer :: nsize ! grid point in values array - real(R8) :: minl(nflds) ! local min - real(R8) :: maxl(nflds) ! local max - character(len=ESMF_MAXSTR) :: name - - !--- formats --- - character(*),parameter :: subName = '(print_FieldExchInfo) ' - character(*),parameter :: F00 = "('(print_FieldExchInfo) ',8a)" - character(*),parameter :: F01 = "('(print_FieldExchInfo) ',a,i9)" - character(*),parameter :: F02 = "('(print_FieldExchInfo) ',a,2es11.3,i4,2x,a)" - !------------------------------------------------------------------------------- + allocate(pes_local(nx_global*ny_global)) + allocate(pes_global(nx_global*ny_global)) + pes_local(:) = 0 + do n = 1,lsize + pes_local(gindex(n)) = iam + end do - if (present(istr)) write(logunit,*) trim(istr) - nsize = size(values, dim=2) - write(logunit,F01) "local size =",nsize - do n = 1, nflds - minl(n) = minval(values(n,:)) - maxl(n) = maxval(values(n,:)) - write(logunit,F02) 'l min/max ',minl(n),maxl(n),n,fldlist(n)%stdname - enddo + call ESMF_VMAllReduce(vm, sendData=pes_local, recvData=pes_global, count=nx_global*ny_global, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - end subroutine Print_FieldExchInfo + do n = 1,numNodes + nodeOwners(n) = pes_global(iurpts(n)) + end do + deallocate(pes_local) + deallocate(pes_global) + + Emesh = ESMF_MeshCreate(parametricDim=2, & + spatialDim=2, & + coordSys=ESMF_COORDSYS_SPH_DEG, & + nodeIds=nodeIds(1:numNodes), & + nodeCoords=nodeCoords, & + nodeOwners=nodeOwners, & + elementIds=elemIds,& + elementTypes=elemTypes, & + elementConn=elemConn, & + elementCoords=elemCoords, & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + deallocate(iurpts) + deallocate(nodeIds, nodeCoords, nodeOwners) + deallocate(elemIds, elemTypes, elemConn, elemCoords) + + end subroutine dead_meshinit end module dead_nuopc_mod diff --git a/src/components/xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 b/src/components/xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 index 21272e5fa27e..331ca704e378 100644 --- a/src/components/xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 @@ -3,6 +3,7 @@ module wav_comp_nuopc !---------------------------------------------------------------------------- ! This is the NUOPC cap for XWAV !---------------------------------------------------------------------------- + use ESMF use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise @@ -11,11 +12,8 @@ module wav_comp_nuopc use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet - use med_constants_mod , only : IN, R8, I8, CXX, CL, CS - use med_constants_mod , only : shr_log_Unit + use med_constants_mod , only : R8, CL, CS use med_constants_mod , only : shr_file_getlogunit, shr_file_setlogunit - use med_constants_mod , only : shr_file_getloglevel, shr_file_setloglevel - use med_constants_mod , only : shr_file_setIO, shr_file_getUnit use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_scalars_mod , only : flds_scalar_num use shr_nuopc_scalars_mod , only : flds_scalar_index_nx @@ -23,13 +21,12 @@ module wav_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_Clock_TimePrint use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_nuopc_grid_mod , only : shr_nuopc_grid_Meshinit + use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_ChkErr use dead_nuopc_mod , only : dead_grid_lat, dead_grid_lon, dead_grid_index - use dead_nuopc_mod , only : dead_init_nuopc, dead_run_nuopc, dead_final_nuopc + use dead_nuopc_mod , only : dead_init_nuopc, dead_final_nuopc, dead_meshinit use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - use dead_nuopc_mod , only : state_getimport, state_setexport - use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, Print_FieldExchInfo + use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock + use med_constants_mod , only : dbug => med_constants_dbug_flag implicit none private ! except @@ -44,70 +41,68 @@ module wav_comp_nuopc integer :: fldsFrWav_num = 0 type (fld_list_type) :: fldsToWav(fldsMax) type (fld_list_type) :: fldsFrWav(fldsMax) - real(r8), pointer :: gbuf(:,:) ! model info + integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost + real(r8), pointer :: lat(:) real(r8), pointer :: lon(:) integer , allocatable :: gindex(:) - real(r8), allocatable :: x2d(:,:) - real(r8), allocatable :: d2x(:,:) integer :: nxg ! global dim i-direction integer :: nyg ! global dim j-direction - integer :: my_task ! my task in mpi communicator mpicom integer :: inst_index ! number of current instance (ie. 1) character(len=16) :: inst_name ! fullname of current instance (ie. "wav_0001") character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") integer :: logunit ! logging unit number - integer, parameter :: master_task = 0 - logical :: mastertask - character(len=*),parameter :: grid_option = "mesh" ! grid_de, grid_arb, grid_reg, mesh + logical :: mastertask character(*),parameter :: modName = "(xwav_comp_nuopc)" - character(*),parameter :: u_FILE_u = __FILE__ - integer, parameter :: dbug = 10 + character(*),parameter :: u_FILE_u = & + __FILE__ !=============================================================================== contains - !=============================================================================== +!=============================================================================== + subroutine SetServices(gcomp, rc) + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! switching to IPD versions call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & userRoutine=ModelInitPhase, phase=0, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! set entry point for methods that require specific implementation call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p1"/), & userRoutine=InitializeAdvertise, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p3"/), & userRoutine=InitializeRealize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! attach specializing method(s) call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, specRoutine=ModelAdvance, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end subroutine SetServices @@ -115,39 +110,38 @@ end subroutine SetServices !=============================================================================== subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_set_component_logging use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance + + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc ! local variables + integer :: n type(ESMF_VM) :: vm - character(CL) :: cvalue character(CS) :: stdname - integer :: n - integer :: lsize ! local array size - integer :: ierr ! error code - integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - logical :: isPresent - character(len=512) :: diro - character(len=512) :: logfile + real(r8), pointer :: gbuf(:,:) ! model info + integer :: my_task ! my task in mpi communicator mpicom + integer :: lsize ! local array size + integer :: shrlogunit ! original log unit character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localpet=my_task, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return - mastertask = my_task == 0 + mastertask = (my_task == 0) !---------------------------------------------------------------------------- ! determine instance information @@ -160,7 +154,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit, shrloglev) + call shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit) !---------------------------------------------------------------------------- ! Initialize xwav @@ -188,13 +182,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrWav_num, fldsFrWav, 'Sw_vstokes' ) call fld_list_add(fldsFrWav_num, fldsFrWav, 'Sw_hstokes' ) - do n = 1,fldsFrWav_num - if (mastertask) write(logunit,*)'Advertising From Xwav ',trim(fldsFrWav(n)%stdname) - call NUOPC_Advertise(exportState, standardName=fldsFrWav(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - enddo - call fld_list_add(fldsToWav_num, fldsToWav, trim(flds_scalar_name)) call fld_list_add(fldsToWav_num, fldsToWav, 'Sa_u' ) call fld_list_add(fldsToWav_num, fldsToWav, 'Sa_v' ) @@ -205,24 +192,28 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToWav_num, fldsToWav, 'So_v' ) call fld_list_add(fldsToWav_num, fldsToWav, 'So_bldepth' ) + do n = 1,fldsFrWav_num + if (mastertask) write(logunit,*)'Advertising From Xwav ',trim(fldsFrWav(n)%stdname) + call NUOPC_Advertise(exportState, standardName=fldsFrWav(n)%stdname, & + TransferOfferGeomObject='will provide', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo + do n = 1,fldsToWav_num if(mastertask) write(logunit,*)'Advertising To Xwav ',trim(fldsToWav(n)%stdname) call NUOPC_Advertise(importState, standardName=fldsToWav(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return enddo - - allocate(d2x(FldsFrWav_num,lsize)); d2x(:,:) = 0._r8 - allocate(x2d(FldsToWav_num,lsize)); x2d(:,:) = 0._r8 end if call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return + !---------------------------------------------------------------------------- ! Reset shr logging to original values !---------------------------------------------------------------------------- - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) end subroutine InitializeAdvertise @@ -230,6 +221,8 @@ end subroutine InitializeAdvertise !=============================================================================== subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -239,10 +232,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) character(ESMF_MAXSTR) :: convCIM, purpComp type(ESMF_Mesh) :: Emesh integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - integer :: n character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' - !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -253,17 +243,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) !-------------------------------- ! generate the mesh - ! grid_option specifies grid or mesh !-------------------------------- - call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call dead_meshinit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -279,7 +266,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':dwavExport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call fld_list_realize( & state=importState, & @@ -289,40 +276,30 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':dwavImport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Pack export state - ! Copy from d2x to exportState - ! Set the coupling scalars !-------------------------------- - do n = 1, FldsFrWav_num - if (fldsFrWav(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrWav(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do + call state_setexport(exportState, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics !-------------------------------- if (dbug > 1) then - if (my_task == master_task) then - call Print_FieldExchInfo(values=d2x, logunit=logunit, & - fldlist=fldsFrWav, nflds=fldsFrWav_num, istr="InitializeRealize: wav->mediator") - end if call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return endif #ifdef USE_ESMF_METADATA @@ -338,7 +315,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_AttributeSet(comp, "ModelType", "Wave", convention=convCIM, purpose=purpComp, rc=rc) #endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -348,25 +324,25 @@ end subroutine InitializeRealize !=============================================================================== subroutine ModelAdvance(gcomp, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_memcheck, shr_nuopc_log_clock_advance + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc ! local variables type(ESMF_Clock) :: clock type(ESMF_State) :: exportState - integer :: n integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call shr_nuopc_memcheck(subname, 3, mastertask) + call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) !-------------------------------- @@ -374,16 +350,10 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call NUOPC_ModelGet(gcomp, modelClock=clock, exportState=exportState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call dead_run_nuopc('wav', d2x, gbuf) + if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1, FldsFrWav_num - if (fldsFrWav(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrWav(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do + call state_setexport(exportState, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics @@ -391,13 +361,12 @@ subroutine ModelAdvance(gcomp, rc) if (dbug > 1) then call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (my_task == master_task) then + if (chkerr(rc,__LINE__,u_FILE_u)) return + if ( mastertask) then call shr_nuopc_log_clock_advance(clock, 'WAV', logunit) endif endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -406,6 +375,91 @@ end subroutine ModelAdvance !=============================================================================== + subroutine state_setexport(exportState, rc) + + ! input/output variables + type(ESMF_State) , intent(inout) :: exportState + integer , intent(out) :: rc + + ! local variables + integer :: nf, nind, nfstart, ubound + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + nfstart = 0 ! for fields that have ubound > 0 + do nf = 2,fldsFrWav_num ! Start from index 2 in order to skip the scalar field + ubound = fldsFrWav(nf)%ungridded_ubound + if (ubound == 0) then + call field_setexport(exportState, trim(fldsFrWav(nf)%stdname), lon, lat, nf=nf, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + nfstart = nfstart + nf + ubound - 1 + do nind = 1,ubound + call field_setexport(exportState, trim(fldsFrWav(nf)%stdname), lon, lat, nf=nfstart+nind-1, & + ungridded_index=nind, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end do + end if + end do + + end subroutine state_setexport + + !=============================================================================== + + subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, rc) + + use shr_const_mod , only : pi=>shr_const_pi + + ! intput/otuput variables + type(ESMF_State) , intent(inout) :: exportState + character(len=*) , intent(in) :: fldname + real(r8) , intent(in) :: lon(:) + real(r8) , intent(in) :: lat(:) + integer , intent(in) :: nf + integer, optional , intent(in) :: ungridded_index + integer , intent(out) :: rc + + ! local variables + integer :: i, ncomp + type(ESMF_Field) :: lfield + real(r8), pointer :: data1d(:) + real(r8), pointer :: data2d(:,:) + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(exportState, itemName=trim(fldname), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ncomp = 7 + if (present(ungridded_index)) then + call ESMF_FieldGet(lfield, farrayPtr=data2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (gridToFieldMap == 1) then + do i = 1,size(data2d, dim=1) + data2d(i,ungridded_index) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + else if (gridToFieldMap == 2) then + do i = 1,size(data2d, dim=2) + data2d(ungridded_index,i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + end if + else + call ESMF_FieldGet(lfield, farrayPtr=data1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do i = 1,size(data1d) + data1d(i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + end if + + end subroutine field_setexport + + !=============================================================================== + subroutine ModelFinalize(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc diff --git a/src/drivers/mct/cime_config/buildexe b/src/drivers/mct/cime_config/buildexe index 5e13c62166b2..288f93f4d212 100755 --- a/src/drivers/mct/cime_config/buildexe +++ b/src/drivers/mct/cime_config/buildexe @@ -31,8 +31,13 @@ def _main_func(): gmake = case.get_value("GMAKE") gmake_j = case.get_value("GMAKE_J") num_esp = case.get_value("NUM_COMP_INST_ESP") + ocn_model = case.get_value("COMP_OCN") + atm_model = case.get_value("COMP_ATM") gmake_opts = get_standard_makefile_args(case) + if ocn_model == 'mom' or atm_model == "fv3gfs": + gmake_opts += "USE_FMS=TRUE" + expect((num_esp is None) or (int(num_esp) == 1), "ESP component restricted to one instance") diff --git a/src/drivers/mct/cime_config/config_component.xml b/src/drivers/mct/cime_config/config_component.xml index d916bcdbfcca..d3fb65a3e2e1 100644 --- a/src/drivers/mct/cime_config/config_component.xml +++ b/src/drivers/mct/cime_config/config_component.xml @@ -11,7 +11,7 @@ char - CPL,ATM,LND,ICE,OCN,ROF,GLC,WAV,ESP + CPL,ATM,LND,ICE,OCN,ROF,GLC,WAV,IAC,ESP env_case.xml case_comp List of component classes supported by this driver @@ -408,6 +408,7 @@ FALSE FALSE FALSE + FALSE @@ -1109,6 +1110,30 @@ number of wav cells in j direction - DO NOT EDIT (for experts only) + + char + UNSET + build_grid + env_build.xml + iac model (iac) grid + + + + integer + 0 + build_grid + env_build.xml + number of iac cells in i direction - DO NOT EDIT (for experts only) + + + + integer + 0 + build_grid + env_build.xml + number of iac cells in j direction - DO NOT EDIT (for experts only) + + char UNSET @@ -1210,6 +1235,22 @@ path of wav domain file + + char + UNSET + run_domain + env_run.xml + iac domain file + + + + char + $DIN_LOC_ROOT/share/domains + run_domain + env_run.xml + path of iac domain file + + char UNSET @@ -1690,6 +1731,74 @@ wav2ocn state mapping file decomp type + + char + idmap + run_domain + env_run.xml + iac2atm flux mapping file + + + + char + X,Y + X + run_domain + env_run.xml + iac2atm flux mapping file decomp type + + + + char + idmap + run_domain + env_run.xml + iac2atm state mapping file + + + + char + X,Y + X + run_domain + env_run.xml + iac2atm state mapping file decomp type + + + + char + idmap + run_domain + env_run.xml + iac2lnd flux mapping file + + + + char + X,Y + X + run_domain + env_run.xml + iac2lnd flux mapping file decomp type + + + + char + idmap + run_domain + env_run.xml + iac2lnd state mapping file + + + + char + X,Y + X + run_domain + env_run.xml + iac2lnd state mapping file decomp type + + char none,npfix,cart3d,cart3d_diag,cart3d_uvw,cart3d_uvw_diag @@ -1924,6 +2033,7 @@ $MAX_MPITASKS_PER_NODE $MAX_MPITASKS_PER_NODE $MAX_MPITASKS_PER_NODE + $MAX_MPITASKS_PER_NODE mach_pes env_mach_pes.xml @@ -1941,6 +2051,7 @@ 0 0 0 + 0 mach_pes env_mach_pes.xml @@ -1959,6 +2070,7 @@ 1 1 1 + 1 mach_pes env_mach_pes.xml @@ -1977,6 +2089,7 @@ 0 0 0 + 0 mach_pes env_mach_pes.xml @@ -2006,6 +2119,7 @@ 1 1 1 + 1 mach_pes env_mach_pes.xml @@ -2026,6 +2140,7 @@ concurrent concurrent concurrent + concurrent mach_pes env_mach_pes.xml @@ -2044,6 +2159,7 @@ 1 1 1 + 1 mach_pes env_mach_pes.xml @@ -2228,6 +2344,7 @@ default default default + default @@ -2249,6 +2366,7 @@ 64bit_offset 64bit_offset 64bit_offset + 64bit_offset @@ -2270,6 +2388,7 @@ + @@ -2290,6 +2409,7 @@ + @@ -2308,6 +2428,7 @@ 1 1 1 + 1 @@ -2329,6 +2450,7 @@ -99 -99 -99 + -99 @@ -2596,6 +2718,7 @@ FALSE FALSE FALSE + FALSE diff --git a/src/drivers/mct/cime_config/config_component_e3sm.xml b/src/drivers/mct/cime_config/config_component_e3sm.xml index aafd3b4a0ff3..7da2b682fc0d 100644 --- a/src/drivers/mct/cime_config/config_component_e3sm.xml +++ b/src/drivers/mct/cime_config/config_component_e3sm.xml @@ -496,6 +496,15 @@ where basedt is equal to NCPL_BASE_PERIOD in seconds. + + integer + $ATM_NCPL + run_coupling + env_run.xml + Number of iac coupling intervals per NCPL_BASE_PERIOD. + This is used to set the driver namelist iac_cpl_dt, equal to basedt/IAC_NCPL + where basedt is equal to NCPL_BASE_PERIOD in seconds. + diff --git a/src/drivers/mct/cime_config/config_compsets.xml b/src/drivers/mct/cime_config/config_compsets.xml index 612c44949f05..0386fbfa0723 100644 --- a/src/drivers/mct/cime_config/config_compsets.xml +++ b/src/drivers/mct/cime_config/config_compsets.xml @@ -24,6 +24,7 @@ ROF = [DROF, SROF, XROF] GLC = [ SGLC ] WAV = [DWAV, SWAV ] + IAC = [ SIAC ] ESP = [DESP, SESP ] The OPTIONAL %phys attributes specify submodes of the given system @@ -40,7 +41,7 @@ A - 2000_DATM%NYF_SLND_DICE%SSMI_DOCN%DOM_DROF%NYF_SGLC_SWAV + 2000_DATM%NYF_SLND_DICE%SSMI_DOCN%DOM_DROF%NYF_SGLC_SWAV_SIAC diff --git a/src/drivers/mct/cime_config/config_pes.xml b/src/drivers/mct/cime_config/config_pes.xml index ad332b3ff030..db4bebb81a72 100644 --- a/src/drivers/mct/cime_config/config_pes.xml +++ b/src/drivers/mct/cime_config/config_pes.xml @@ -14,7 +14,8 @@ -1 -1 -1 - -1 + -1 + -1 -1 @@ -24,7 +25,8 @@ 1 1 1 - 1 + 1 + 1 1 1 @@ -36,7 +38,8 @@ 0 0 0 - 0 + 0 + 0 0 diff --git a/src/drivers/mct/cime_config/namelist_definition_drv.xml b/src/drivers/mct/cime_config/namelist_definition_drv.xml index 0f0e779377a9..f63c78459eee 100644 --- a/src/drivers/mct/cime_config/namelist_definition_drv.xml +++ b/src/drivers/mct/cime_config/namelist_definition_drv.xml @@ -812,6 +812,18 @@ + + char + mapping + seq_infodata_inparm + + IAC_GRID values passed into driver. + + + $IAC_GRID + + + logical mapping @@ -1286,6 +1298,19 @@ + + logical + history + seq_infodata_inparm + + writes iac fields in coupler average history files. + default: true + + + .true. + + + logical history @@ -1622,6 +1647,19 @@ + + integer + time + seq_timemgr_inparm + + iac coupling interval in seconds + set via IAC_NCPL in env_run.xml. + IAC_NCPL is the number of times the iac is coupled per NCPL_BASE_PERIOD + NCPL_BASE_PERIOD is also set in env_run.xml and is the base period + associated with NCPL coupling frequency, nad has valid values: hour,day,year,decade + + + integer time @@ -1711,6 +1749,18 @@ + + integer + time + seq_timemgr_inparm + + iac coupling interval offset in seconds default: 0 + + + 0 + + + integer time @@ -2192,6 +2242,18 @@ + + logical + time + seq_timemgr_inparm + + Whether Pause signals are active for component iac + + + $PAUSE_ACTIVE_IAC + + + logical time @@ -2691,6 +2753,71 @@ + + integer + cime_pes + cime_pes + + the number of mpi tasks assigned to the iac components. + set by NTASKS_IAC in env_configure.xml. + + + $NTASKS_IAC + + + + + integer + cime_pes + cime_pes + + the number of threads per mpi task for the iac component. + set by NTHRDS_IAC in env_configure.xml. + + + $NTHRDS_IAC + + + + + integer + cime_pes + cime_pes + + the global mpi task rank of the root processor assigned to the iac component. + set by ROOTPE_IAC in env_configure.xml. + + + $ROOTPE_IAC + + + + + integer + cime_pes + cime_pes + + the mpi global processors stride associated with the mpi tasks for the iac component. + set by PSTRID_IAC in env_configure.xml. + + + $PSTRID_IAC + + + + + char + cime_pes + cime_pes + concurrent,sequential + + Layout of multi-instance iacs (if there are more than 1) + + + $NINST_IAC_LAYOUT + + + integer cime_pes @@ -4174,6 +4301,126 @@ + + char + mapping + abs + seq_maps + + iac to atm mapping file for fluxes + + + $IAC2ATM_FMAPNAME + + + + + char + mapping + seq_maps + + The type of mapping desired, either "source" or "destination" mapping. + X is associated with rearrangement of the source grid to the + destination grid and then local mapping. Y is associated with mapping + on the source grid and then rearrangement and sum to the destination + grid. + + + $IAC2ATM_FMAPTYPE + X + + + + + char + mapping + abs + seq_maps + + iac to atm mapping file for states + + + $IAC2ATM_SMAPNAME + + + + + char + mapping + seq_maps + + The type of mapping desired, either "source" or "destination" mapping. + X is associated with rearrangement of the source grid to the + destination grid and then local mapping. Y is associated with mapping + on the source grid and then rearrangement and sum to the destination + grid. + + + $IAC2ATM_SMAPTYPE + X + + + + + char + mapping + abs + seq_maps + + iac to lnd mapping file for fluxes + + + $IAC2LND_FMAPNAME + + + + + char + mapping + seq_maps + + The type of mapping desired, either "source" or "destination" mapping. + X is associated with rearrangement of the source grid to the + destination grid and then local mapping. Y is associated with mapping + on the source grid and then rearrangement and sum to the destination + grid. + + + $IAC2LND_FMAPTYPE + X + + + + + char + mapping + abs + seq_maps + + iac to lnd mapping file for states + + + $IAC2LND_SMAPNAME + + + + + char + mapping + seq_maps + + The type of mapping desired, either "source" or "destination" mapping. + X is associated with rearrangement of the source grid to the + destination grid and then local mapping. Y is associated with mapping + on the source grid and then rearrangement and sum to the destination + grid. + + + $IAC2LND_SMAPTYPE + X + + + logical data_assimilation @@ -4222,6 +4469,18 @@ + + logical + data_assimilation + seq_timemgr_inparm + + Whether Data Assimilation is on for component iac + + + $DATA_ASSIMILATION_IAC + + + logical data_assimilation diff --git a/src/drivers/mct/cime_config/namelist_definition_modelio.xml b/src/drivers/mct/cime_config/namelist_definition_modelio.xml index ea5d47f0a4ae..660bc93dee3e 100644 --- a/src/drivers/mct/cime_config/namelist_definition_modelio.xml +++ b/src/drivers/mct/cime_config/namelist_definition_modelio.xml @@ -60,6 +60,7 @@ $ROF_PIO_STRIDE $GLC_PIO_STRIDE $WAV_PIO_STRIDE + $IAC_PIO_STRIDE -99 @@ -80,6 +81,7 @@ $ROF_PIO_ROOT $GLC_PIO_ROOT $WAV_PIO_ROOT + $IAC_PIO_ROOT -99 @@ -101,6 +103,7 @@ $ROF_PIO_REARRANGER $GLC_PIO_REARRANGER $WAV_PIO_REARRANGER + $IAC_PIO_REARRANGER -99 @@ -121,6 +124,7 @@ $ROF_PIO_NUMTASKS $GLC_PIO_NUMTASKS $WAV_PIO_NUMTASKS + $IAC_PIO_NUMTASKS -99 @@ -143,6 +147,7 @@ $ROF_PIO_TYPENAME $GLC_PIO_TYPENAME $WAV_PIO_TYPENAME + $IAC_PIO_TYPENAME nothing @@ -166,6 +171,7 @@ $ROF_PIO_NETCDF_FORMAT $GLC_PIO_NETCDF_FORMAT $WAV_PIO_NETCDF_FORMAT + $IAC_PIO_NETCDF_FORMAT diff --git a/src/drivers/mct/main/cime_comp_mod.F90 b/src/drivers/mct/main/cime_comp_mod.F90 index 6a59ca1fc5d7..a0831467fe3d 100644 --- a/src/drivers/mct/main/cime_comp_mod.F90 +++ b/src/drivers/mct/main/cime_comp_mod.F90 @@ -54,6 +54,7 @@ module cime_comp_mod use wav_comp_mct , only: wav_init=>wav_init_mct, wav_run=>wav_run_mct, wav_final=>wav_final_mct use rof_comp_mct , only: rof_init=>rof_init_mct, rof_run=>rof_run_mct, rof_final=>rof_final_mct use esp_comp_mct , only: esp_init=>esp_init_mct, esp_run=>esp_run_mct, esp_final=>esp_final_mct + use iac_comp_mct , only: iac_init=>iac_init_mct, iac_run=>iac_run_mct, iac_final=>iac_final_mct !---------------------------------------------------------------------------- ! cpl7 modules @@ -66,9 +67,11 @@ module cime_comp_mod use seq_comm_mct, only: CPLALLATMID,CPLALLLNDID,CPLALLOCNID,CPLALLICEID use seq_comm_mct, only: CPLALLGLCID,CPLALLROFID,CPLALLWAVID,CPLALLESPID use seq_comm_mct, only: CPLATMID,CPLLNDID,CPLOCNID,CPLICEID,CPLGLCID,CPLROFID,CPLWAVID,CPLESPID + use seq_comm_mct, only: IACID, ALLIACID, CPLALLIACID, CPLIACID use seq_comm_mct, only: num_inst_atm, num_inst_lnd, num_inst_rof use seq_comm_mct, only: num_inst_ocn, num_inst_ice, num_inst_glc use seq_comm_mct, only: num_inst_wav, num_inst_esp + use seq_comm_mct, only: num_inst_iac use seq_comm_mct, only: num_inst_xao, num_inst_frc, num_inst_phys use seq_comm_mct, only: num_inst_total, num_inst_max use seq_comm_mct, only: seq_comm_iamin, seq_comm_name, seq_comm_namelen @@ -101,6 +104,7 @@ module cime_comp_mod use seq_timemgr_mod, only: seq_timemgr_alarm_rofrun use seq_timemgr_mod, only: seq_timemgr_alarm_wavrun use seq_timemgr_mod, only: seq_timemgr_alarm_esprun + use seq_timemgr_mod, only: seq_timemgr_alarm_iacrun use seq_timemgr_mod, only: seq_timemgr_alarm_barrier use seq_timemgr_mod, only: seq_timemgr_alarm_pause use seq_timemgr_mod, only: seq_timemgr_pause_active @@ -149,12 +153,13 @@ module cime_comp_mod use seq_flds_mod, only : seq_flds_w2x_fluxes, seq_flds_x2w_fluxes use seq_flds_mod, only : seq_flds_r2x_fluxes, seq_flds_x2r_fluxes use seq_flds_mod, only : seq_flds_set + use seq_flds_mod, only : seq_flds_z2x_fluxes, seq_flds_x2z_fluxes ! component type and accessor functions use component_type_mod, only: component_get_iamin_compid, component_get_suffix use component_type_mod, only: component_get_iamroot_compid use component_type_mod, only: component_get_name, component_get_c2x_cx - use component_type_mod, only: atm, lnd, ice, ocn, rof, glc, wav, esp + use component_type_mod, only: atm, lnd, ice, ocn, rof, glc, wav, esp, iac use component_mod, only: component_init_pre use component_mod, only: component_init_cc, component_init_cx use component_mod, only: component_run, component_final @@ -170,6 +175,7 @@ module cime_comp_mod use prep_ocn_mod use prep_atm_mod use prep_aoflux_mod + use prep_iac_mod !--- mapping routines --- use seq_map_type_mod @@ -214,6 +220,8 @@ module cime_comp_mod private :: cime_run_ice_recv_post private :: cime_run_wav_setup_send private :: cime_run_wav_recv_post + private :: cime_run_iac_setup_send + private :: cime_run_iac_recv_post private :: cime_run_update_fractions private :: cime_run_calc_budgets1 private :: cime_run_calc_budgets2 @@ -253,6 +261,7 @@ module cime_comp_mod type(mct_aVect) , pointer :: fractions_gx(:) ! Fractions on glc grid, cpl processes type(mct_aVect) , pointer :: fractions_rx(:) ! Fractions on rof grid, cpl processes type(mct_aVect) , pointer :: fractions_wx(:) ! Fractions on wav grid, cpl processes + type(mct_aVect) , pointer :: fractions_zx(:) ! Fractions on iac grid, cpl processes !--- domain equivalent 2d grid size --- integer :: atm_nx, atm_ny ! nx, ny of 2d grid, if known @@ -262,6 +271,7 @@ module cime_comp_mod integer :: rof_nx, rof_ny integer :: glc_nx, glc_ny integer :: wav_nx, wav_ny + integer :: iac_nx, iac_ny !---------------------------------------------------------------------------- ! Infodata: inter-model control flags, domain info @@ -283,6 +293,7 @@ module cime_comp_mod type (ESMF_Clock), target :: EClock_r ! rof clock type (ESMF_Clock), target :: EClock_w ! wav clock type (ESMF_Clock), target :: EClock_e ! esp clock + type (ESMF_Clock), target :: EClock_z ! iac clock logical :: restart_alarm ! restart alarm logical :: history_alarm ! history alarm @@ -298,6 +309,7 @@ module cime_comp_mod logical :: rofrun_alarm ! rof run alarm logical :: wavrun_alarm ! wav run alarm logical :: esprun_alarm ! esp run alarm + logical :: iacrun_alarm ! iac run alarm logical :: tprof_alarm ! timing profile alarm logical :: barrier_alarm ! barrier alarm logical :: t1hr_alarm ! alarm every hour @@ -379,6 +391,7 @@ module cime_comp_mod logical :: flood_present ! .true. => rof is computing flood logical :: wav_present ! .true. => wav is present logical :: esp_present ! .true. => esp is present + logical :: iac_present ! .true. => iac is present logical :: atm_prognostic ! .true. => atm comp expects input logical :: lnd_prognostic ! .true. => lnd comp expects input @@ -390,6 +403,7 @@ module cime_comp_mod logical :: rof_prognostic ! .true. => rof comp expects input logical :: wav_prognostic ! .true. => wav comp expects input logical :: esp_prognostic ! .true. => esp comp expects input + logical :: iac_prognostic ! .true. => iac comp expects input logical :: atm_c2_lnd ! .true. => atm to lnd coupling on logical :: atm_c2_ocn ! .true. => atm to ocn coupling on @@ -412,6 +426,10 @@ module cime_comp_mod logical :: glc_c2_ice ! .true. => glc to ice coupling on logical :: wav_c2_ocn ! .true. => wav to ocn coupling on + logical :: iac_c2_lnd ! .true. => iac to lnd coupling on + logical :: iac_c2_atm ! .true. => iac to atm coupling on + logical :: lnd_c2_iac ! .true. => lnd to iac coupling on + logical :: dead_comps ! .true. => dead components logical :: esmf_map_flag ! .true. => use esmf for mapping @@ -438,6 +456,7 @@ module cime_comp_mod character(CL) :: rof_gnam ! rof grid character(CL) :: glc_gnam ! glc grid character(CL) :: wav_gnam ! wav grid + character(CL) :: iac_gnam ! iac grid logical :: samegrid_ao ! samegrid atm and ocean logical :: samegrid_al ! samegrid atm and land @@ -450,6 +469,7 @@ module cime_comp_mod logical :: samegrid_og ! samegrid glc and ocean logical :: samegrid_ig ! samegrid glc and ice logical :: samegrid_alo ! samegrid atm, lnd, ocean + logical :: samegrid_zl ! samegrid iac and land logical :: read_restart ! local read restart flag character(CL) :: rest_file ! restart file path + filename @@ -537,6 +557,7 @@ module cime_comp_mod integer :: nthreads_ROFID ! OMP glc number of threads integer :: nthreads_WAVID ! OMP wav number of threads integer :: nthreads_ESPID ! OMP esp number of threads + integer :: nthreads_IACID ! OMP iac number of threads integer :: pethreads_GLOID ! OMP number of threads per task @@ -557,6 +578,7 @@ module cime_comp_mod integer :: mpicom_CPLALLGLCID ! MPI comm for CPLALLGLCID integer :: mpicom_CPLALLROFID ! MPI comm for CPLALLROFID integer :: mpicom_CPLALLWAVID ! MPI comm for CPLALLWAVID + integer :: mpicom_CPLALLIACID ! MPI comm for CPLALLIACID integer :: iam_GLOID ! pe number in global id logical :: iamin_CPLID ! pe associated with CPLID @@ -570,6 +592,7 @@ module cime_comp_mod logical :: iamin_CPLALLGLCID ! pe associated with CPLALLGLCID logical :: iamin_CPLALLROFID ! pe associated with CPLALLROFID logical :: iamin_CPLALLWAVID ! pe associated with CPLALLWAVID + logical :: iamin_CPLALLIACID ! pe associated with CPLALLIACID !---------------------------------------------------------------------------- @@ -592,6 +615,7 @@ module cime_comp_mod integer, parameter :: comp_num_rof = 6 integer, parameter :: comp_num_wav = 7 integer, parameter :: comp_num_esp = 8 + integer, parameter :: comp_num_iac = 9 !---------------------------------------------------------------------------- ! misc @@ -599,7 +623,7 @@ module cime_comp_mod integer, parameter :: ens1=1 ! use first instance of ensemble only integer, parameter :: fix1=1 ! temporary hard-coding to first ensemble, needs to be fixed - integer :: eai, eli, eoi, eii, egi, eri, ewi, eei, exi, efi ! component instance counters + integer :: eai, eli, eoi, eii, egi, eri, ewi, eei, exi, efi, ezi ! component instance counters !---------------------------------------------------------------------------- ! formats @@ -770,7 +794,23 @@ subroutine cime_pre_init1(esmf_log_option) call seq_comm_getinfo(CPLALLWAVID, mpicom=mpicom_CPLALLWAVID) iamin_CPLALLWAVID = seq_comm_iamin(CPLALLWAVID) - do eei = 1,num_inst_esp + ! IAC mods + do ezi = 1,num_inst_iac + it=it+1 + comp_id(it) = IACID(ezi) + comp_iamin(it) = seq_comm_iamin(comp_id(it)) + comp_name(it) = seq_comm_name(comp_id(it)) + call seq_comm_getinfo(IACID(ezi), mpicom=comp_comm(it), & + nthreads=nthreads_IACID, iam=comp_comm_iam(it)) + if (seq_comm_iamin(IACID(ezi))) then + complist = trim(complist)//' '//trim(seq_comm_name(IACID(ezi))) + endif + if (seq_comm_iamroot(IACID(ezi))) output_perf = .true. + enddo + call seq_comm_getinfo(CPLALLIACID, mpicom=mpicom_CPLALLIACID) + iamin_CPLALLIACID = seq_comm_iamin(CPLALLIACID) + + do eei = 1,num_inst_esp it=it+1 comp_id(it) = ESPID(eei) comp_iamin(it) = seq_comm_iamin(comp_id(it)) @@ -931,10 +971,11 @@ subroutine cime_pre_init2() !---------------------------------------------------------- !| Timer initialization (has to be after mpi init) !---------------------------------------------------------- + maxthreads = max(nthreads_GLOID,nthreads_CPLID,nthreads_ATMID, & nthreads_LNDID,nthreads_ICEID,nthreads_OCNID,nthreads_GLCID, & - nthreads_ROFID, nthreads_WAVID, nthreads_ESPID, pethreads_GLOID ) - + nthreads_ROFID, nthreads_WAVID, nthreads_ESPID, nthreads_IACID, & + pethreads_GLOID ) call t_initf(NLFileName, LogPrint=.true., mpicom=mpicom_GLOID, & MasterTask=iamroot_GLOID,MaxThreads=maxthreads) @@ -1000,6 +1041,7 @@ subroutine cime_pre_init2() rof_present=rof_present , & wav_present=wav_present , & esp_present=esp_present , & + iac_present=iac_present , & single_column=single_column , & aqua_planet=aqua_planet , & cpl_seq_option=cpl_seq_option , & @@ -1033,6 +1075,7 @@ subroutine cime_pre_init2() rof_gnam=rof_gnam , & glc_gnam=glc_gnam , & wav_gnam=wav_gnam , & + iac_gnam=iac_gnam , & tfreeze_option = tfreeze_option , & cpl_decomp=seq_mctext_decomp , & shr_map_dopole=shr_map_dopole , & @@ -1104,6 +1147,9 @@ subroutine cime_pre_init2() call seq_comm_setnthreads(nthreads_ESPID) if (iamroot_GLOID) write(logunit,'(2A,2I4)') subname,' nthreads_ESPID = ',& nthreads_ESPID,seq_comm_getnthreads() + call seq_comm_setnthreads(nthreads_IACID) + if (iamroot_GLOID) write(logunit,'(2A,2I4)') subname,' nthreads_IACID = ',& + nthreads_IACID,seq_comm_getnthreads() if (iamroot_GLOID) write(logunit,*) ' ' call seq_comm_setnthreads(nthreads_GLOID) @@ -1116,7 +1162,8 @@ subroutine cime_pre_init2() call seq_timemgr_clockInit(seq_SyncClock, nlfilename, & read_restart, rest_file, pioid, mpicom_gloid, & EClock_d, EClock_a, EClock_l, EClock_o, & - EClock_i, Eclock_g, Eclock_r, Eclock_w, Eclock_e) + EClock_i, Eclock_g, Eclock_r, Eclock_w, Eclock_e, & + EClock_z) if (iamroot_CPLID) then call seq_timemgr_clockPrint(seq_SyncClock) @@ -1194,6 +1241,7 @@ subroutine cime_pre_init2() ice_phase=1, & glc_phase=1, & wav_phase=1, & + iac_phase=1, & esp_phase=1) !---------------------------------------------------------- @@ -1257,7 +1305,7 @@ subroutine cime_init() call t_startf('CPL:init_comps') if (iamroot_CPLID )then write(logunit,*) ' ' - write(logunit,F00) 'Initialize each component: atm, lnd, rof, ocn, ice, glc, wav, esp' + write(logunit,F00) 'Initialize each component: atm, lnd, rof, ocn, ice, glc, wav, esp, iac' call shr_sys_flush(logunit) endif @@ -1270,6 +1318,8 @@ subroutine cime_init() call component_init_pre(glc, GLCID, CPLGLCID, CPLALLGLCID, infodata, ntype='glc') call component_init_pre(wav, WAVID, CPLWAVID, CPLALLWAVID, infodata, ntype='wav') call component_init_pre(esp, ESPID, CPLESPID, CPLALLESPID, infodata, ntype='esp') + call component_init_pre(iac, IACID, CPLIACID, CPLALLIACID, infodata, ntype='iac') + call t_stopf('CPL:comp_init_pre_all') call t_startf('CPL:comp_init_cc_atm') @@ -1321,6 +1371,12 @@ subroutine cime_init() call t_adj_detailf(-2) call t_stopf('CPL:comp_init_cc_esp') + call t_startf('comp_init_cc_iac') + call t_adj_detailf(+2) + call component_init_cc(Eclock_z, iac, iac_init, infodata, NLFilename) + call t_adj_detailf(-2) + call t_stopf('comp_init_cc_iac') + call t_startf('CPL:comp_init_cx_all') call t_adj_detailf(+2) call component_init_cx(atm, infodata) @@ -1330,6 +1386,7 @@ subroutine cime_init() call component_init_cx(ice, infodata) call component_init_cx(glc, infodata) call component_init_cx(wav, infodata) + call component_init_cx(iac, infodata) call t_adj_detailf(-2) call t_stopf('CPL:comp_init_cx_all') @@ -1383,6 +1440,14 @@ subroutine cime_init() endif enddo + do ezi = 1,num_inst_iac + iamin_ID = component_get_iamin_compid(iac(ezi)) + if (iamin_ID) then + compname = component_get_name(iac(ezi)) + complist = trim(complist)//' '//trim(compname) + endif + enddo + do eei = 1,num_inst_esp iamin_ID = component_get_iamin_compid(esp(eei)) if (iamin_ID) then @@ -1406,6 +1471,7 @@ subroutine cime_init() if (iamin_CPLALLGLCID) call seq_infodata_exchange(infodata,CPLALLGLCID,'cpl2glc_init') if (iamin_CPLALLROFID) call seq_infodata_exchange(infodata,CPLALLROFID,'cpl2rof_init') if (iamin_CPLALLWAVID) call seq_infodata_exchange(infodata,CPLALLWAVID,'cpl2wav_init') + if (iamin_CPLALLIACID) call seq_infodata_exchange(infodata,CPLALLIACID,'cpl2iac_init') if (iamroot_CPLID) then write(logunit,F00) 'Determine final settings for presence of surface components' @@ -1424,6 +1490,7 @@ subroutine cime_init() rof_present=rof_present, & rofice_present=rofice_present, & wav_present=wav_present, & + iac_present=iac_present, & esp_present=esp_present, & flood_present=flood_present, & atm_prognostic=atm_prognostic, & @@ -1435,6 +1502,7 @@ subroutine cime_init() glc_prognostic=glc_prognostic, & rof_prognostic=rof_prognostic, & wav_prognostic=wav_prognostic, & + iac_prognostic=iac_prognostic, & esp_prognostic=esp_prognostic, & dead_comps=dead_comps, & esmf_map_flag=esmf_map_flag, & @@ -1445,6 +1513,7 @@ subroutine cime_init() glc_nx=glc_nx, glc_ny=glc_ny, & ocn_nx=ocn_nx, ocn_ny=ocn_ny, & wav_nx=wav_nx, wav_ny=wav_ny, & + iac_nx=iac_nx, iac_ny=iac_ny, & atm_aero=atm_aero ) ! derive samegrid flags @@ -1498,6 +1567,9 @@ subroutine cime_init() glc_c2_ocn = .false. glc_c2_ice = .false. wav_c2_ocn = .false. + iac_c2_atm = .false. + iac_c2_lnd = .false. + lnd_c2_iac = .false. if (atm_present) then if (lnd_prognostic) atm_c2_lnd = .true. @@ -1510,6 +1582,7 @@ subroutine cime_init() if (atm_prognostic) lnd_c2_atm = .true. if (rof_prognostic) lnd_c2_rof = .true. if (glc_prognostic) lnd_c2_glc = .true. + if (iac_prognostic) lnd_c2_iac = .true. endif if (ocn_present) then if (atm_prognostic) ocn_c2_atm = .true. @@ -1535,6 +1608,10 @@ subroutine cime_init() if (wav_present) then if (ocn_prognostic) wav_c2_ocn = .true. endif + if (iac_present) then + if (lnd_prognostic) iac_c2_lnd = .true. + if (atm_prognostic) iac_c2_atm = .true. + endif !---------------------------------------------------------- ! Set domain check and other flag @@ -1580,6 +1657,7 @@ subroutine cime_init() write(logunit,F0L)'rof/ice present = ',rofice_present write(logunit,F0L)'rof/flood present = ',flood_present write(logunit,F0L)'wav model present = ',wav_present + write(logunit,F0L)'iac model present = ',iac_present write(logunit,F0L)'esp model present = ',esp_present write(logunit,F0L)'atm model prognostic = ',atm_prognostic @@ -1591,6 +1669,7 @@ subroutine cime_init() write(logunit,F0L)'rof model prognostic = ',rof_prognostic write(logunit,F0L)'ocn rof prognostic = ',ocnrof_prognostic write(logunit,F0L)'wav model prognostic = ',wav_prognostic + write(logunit,F0L)'iac model prognostic = ',iac_prognostic write(logunit,F0L)'esp model prognostic = ',esp_prognostic write(logunit,F0L)'atm_c2_lnd = ',atm_c2_lnd @@ -1613,6 +1692,8 @@ subroutine cime_init() write(logunit,F0L)'glc_c2_ocn = ',glc_c2_ocn write(logunit,F0L)'glc_c2_ice = ',glc_c2_ice write(logunit,F0L)'wav_c2_ocn = ',wav_c2_ocn + write(logunit,F0L)'iac_c2_lnd = ',iac_c2_lnd + write(logunit,F0L)'iac_c2_atm = ',iac_c2_atm write(logunit,F0L)'dead components = ',dead_comps write(logunit,F0L)'domain_check = ',domain_check @@ -1623,6 +1704,7 @@ subroutine cime_init() write(logunit,F01)'ocn_nx,ocn_ny = ',ocn_nx,ocn_ny,trim(ocn_gnam) write(logunit,F01)'glc_nx,glc_ny = ',glc_nx,glc_ny,trim(glc_gnam) write(logunit,F01)'wav_nx,wav_ny = ',wav_nx,wav_ny,trim(wav_gnam) + write(logunit,F01)'iac_nx,iac_ny = ',iac_nx,iac_ny,trim(iac_gnam) write(logunit,F0L)'samegrid_ao = ',samegrid_ao write(logunit,F0L)'samegrid_al = ',samegrid_al write(logunit,F0L)'samegrid_ro = ',samegrid_ro @@ -1667,6 +1749,9 @@ subroutine cime_init() if (esp_prognostic .and. .not.esp_present) then call shr_sys_abort(subname//' ERROR: if prognostic esp must also have esp present') endif + if (iac_prognostic .and. .not.iac_present) then + call shr_sys_abort(subname//' ERROR: if prognostic iac must also have iac present') + endif #ifndef CPL_BYPASS if ((ice_prognostic .or. ocn_prognostic .or. lnd_prognostic) .and. .not. atm_present) then call shr_sys_abort(subname//' ERROR: if prognostic surface model must also have atm present') @@ -1711,6 +1796,8 @@ subroutine cime_init() call shr_sys_abort(subname//' ERROR: rof_prognostic but num_inst_rof not num_inst_max') if (wav_prognostic .and. num_inst_wav /= num_inst_max) & call shr_sys_abort(subname//' ERROR: wav_prognostic but num_inst_wav not num_inst_max') + if (iac_prognostic .and. num_inst_iac /= num_inst_max) & + call shr_sys_abort(subname//' ERROR: iac_prognostic but num_inst_iac not num_inst_max') !---------------------------------------------------------- !| Initialize attribute vectors for prep_c2C_init_avs routines and fractions @@ -1723,9 +1810,9 @@ subroutine cime_init() call t_adj_detailf(+2) if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - call prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm) + call prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_lnd) - call prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd) + call prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_lnd) call prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_ocn, wav_c2_ocn, glc_c2_ocn) @@ -1737,6 +1824,8 @@ subroutine cime_init() call prep_wav_init(infodata, atm_c2_wav, ocn_c2_wav, ice_c2_wav) + call prep_iac_init(infodata, lnd_c2_iac) + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) call t_adj_detailf(-2) call t_stopf('CPL:init_maps') @@ -1835,6 +1924,9 @@ subroutine cime_init() call mpi_barrier(mpicom_GLOID,ierr) if (wav_present) call component_init_areacor(wav, areafact_samegrid, seq_flds_w2x_fluxes) + call mpi_barrier(mpicom_GLOID,ierr) + if (iac_present) call component_init_areacor(iac, areafact_samegrid, seq_flds_z2x_fluxes) + call t_adj_detailf(-2) call t_stopf ('CPL:init_areacor') @@ -1875,6 +1967,10 @@ subroutine cime_init() call component_diag(infodata, wav, flow='c2x', comment='recv IC wav', & info_debug=info_debug) endif + if (iac_present) then + call component_diag(infodata, iac, flow='c2x', comment='recv IC iac', & + info_debug=info_debug) + endif if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) call t_adj_detailf(-2) @@ -1896,6 +1992,7 @@ subroutine cime_init() allocate(fractions_gx(num_inst_frc)) allocate(fractions_rx(num_inst_frc)) allocate(fractions_wx(num_inst_frc)) + allocate(fractions_zx(num_inst_frc)) if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) do efi = 1,num_inst_frc @@ -1909,10 +2006,10 @@ subroutine cime_init() call seq_frac_init(infodata, & atm(ens1), ice(ens1), lnd(ens1), & ocn(ens1), glc(ens1), rof(ens1), & - wav(ens1), & + wav(ens1), iac(ens1), & fractions_ax(efi), fractions_ix(efi), fractions_lx(efi), & fractions_ox(efi), fractions_gx(efi), fractions_rx(efi), & - fractions_wx(efi)) + fractions_wx(efi), fractions_zx(efi)) if (iamroot_CPLID) then write(logunit,*) ' ' @@ -2103,9 +2200,9 @@ subroutine cime_init() call seq_diag_zero_mct(mode='all') if (read_restart .and. iamin_CPLID) then call seq_rest_read(rest_file, infodata, & - atm, lnd, ice, ocn, rof, glc, wav, esp, & + atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx) + fractions_rx, fractions_gx, fractions_wx, fractions_zx) endif call t_adj_detailf(-2) @@ -2152,9 +2249,9 @@ subroutine cime_init() call shr_sys_flush(logunit) endif call seq_hist_write(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, & + atm, lnd, ice, ocn, rof, glc, wav, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx, trim(cpl_inst_tag)) + fractions_rx, fractions_gx, fractions_wx, fractions_zx, trim(cpl_inst_tag)) if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) call t_adj_detailf(-2) @@ -2182,7 +2279,7 @@ subroutine cime_run() use shr_string_mod, only: shr_string_listGetIndexF use seq_comm_mct, only: atm_layout, lnd_layout, ice_layout use seq_comm_mct, only: glc_layout, rof_layout, ocn_layout - use seq_comm_mct, only: wav_layout, esp_layout, num_inst_driver + use seq_comm_mct, only: wav_layout, esp_layout, iac_layout, num_inst_driver use seq_comm_mct, only: seq_comm_inst use seq_pauseresume_mod, only: seq_resume_store_comp, seq_resume_get_files use seq_pauseresume_mod, only: seq_resume_free @@ -2262,6 +2359,7 @@ subroutine cime_run() esprun_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_esprun) ocnrun_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_ocnrun) ocnnext_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_ocnnext) + iacrun_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_iacrun) restart_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_restart) history_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_history) histavg_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_histavg) @@ -2350,7 +2448,7 @@ subroutine cime_run() write(logunit,102) ' Alarm_state: model date = ',ymd,tod, & ' aliogrw run alarms = ', atmrun_alarm, lndrun_alarm, & icerun_alarm, ocnrun_alarm, glcrun_alarm, & - rofrun_alarm, wavrun_alarm, esprun_alarm + rofrun_alarm, wavrun_alarm, esprun_alarm, iacrun_alarm write(logunit,102) ' Alarm_state: model date = ',ymd,tod, & ' 1.2.3.6.12.24 run alarms = ', t1hr_alarm, t2hr_alarm, & t3hr_alarm, t6hr_alarm, t12hr_alarm, t24hr_alarm @@ -2360,6 +2458,13 @@ subroutine cime_run() call t_stopf ('CPL:CLOCK_ADVANCE') + !---------------------------------------------------------- + !| IAC SETUP-SEND + !---------------------------------------------------------- + if (iac_present .and. iacrun_alarm) then + call cime_run_iac_setup_send() + endif + !---------------------------------------------------------- !| MAP ATM to OCN ! Set a2x_ox as a module variable in prep_ocn_mod @@ -2428,6 +2533,18 @@ subroutine cime_run() call cime_run_rof_setup_send() endif + !---------------------------------------------------------- + !| RUN IAC MODEL + !---------------------------------------------------------- + if (iac_present .and. iacrun_alarm) then + call component_run(Eclock_z, iac, iac_run, infodata, & + seq_flds_x2c_fluxes=seq_flds_x2z_fluxes, & + seq_flds_c2x_fluxes=seq_flds_z2x_fluxes, & + comp_prognostic=iac_prognostic, comp_num=comp_num_iac, & + timer_barrier= 'CPL:IAC_RUN_BARRIER', timer_comp_run='CPL:IAC_RUN', & + run_barriers=run_barriers, ymd=ymd, tod=tod,comp_layout=iac_layout) + endif + !---------------------------------------------------------- !| RUN ICE MODEL !---------------------------------------------------------- @@ -2490,6 +2607,13 @@ subroutine cime_run() endif end if + !---------------------------------------------------------- + !| IAC RECV-POST + !---------------------------------------------------------- + if (iac_present .and. iacrun_alarm) then + call cime_run_iac_recv_post() + endif + !---------------------------------------------------------- !| OCN RECV-POST (cesm1_mod_tight, nuopc_tight) !---------------------------------------------------------- @@ -2703,16 +2827,16 @@ subroutine cime_run() endif call seq_hist_write(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, & + atm, lnd, ice, ocn, rof, glc, wav, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx, trim(cpl_inst_tag)) + fractions_rx, fractions_gx, fractions_wx, fractions_zx, trim(cpl_inst_tag)) if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) endif if (do_histavg) then call seq_hist_writeavg(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, histavg_alarm, & + atm, lnd, ice, ocn, rof, glc, wav, iac, histavg_alarm, & trim(cpl_inst_tag)) endif @@ -2986,9 +3110,9 @@ subroutine cime_run() end if if (iamin_CPLID) then call seq_rest_read(drv_resume, infodata, & - atm, lnd, ice, ocn, rof, glc, wav, esp, & + atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx) + fractions_rx, fractions_gx, fractions_wx, fractions_zx) end if ! Clear the resume file so we don't try to read it again drv_resume = ' ' @@ -3063,7 +3187,8 @@ subroutine cime_run() lnd(ens1)%iamroot_compid .or. & ice(ens1)%iamroot_compid .or. & glc(ens1)%iamroot_compid .or. & - wav(ens1)%iamroot_compid) then + wav(ens1)%iamroot_compid .or. & + iac(ens1)%iamroot_compid) then call shr_mem_getusage(msize,mrss,.true.) write(logunit,105) ' memory_write: model date = ',ymd,tod, & @@ -3169,6 +3294,7 @@ subroutine cime_final() call component_final(EClock_o, ocn, ocn_final) call component_final(EClock_g, glc, glc_final) call component_final(EClock_w, wav, wav_final) + call component_final(EClock_w, iac, iac_final) !------------------------------------------------------------------------ ! End the run cleanly @@ -3455,6 +3581,9 @@ subroutine cime_run_atm_setup_send() if (lnd_c2_atm) then call prep_atm_calc_l2x_ax(fractions_lx, timer='CPL:atmprep_lnd2atm') endif + if (iac_c2_atm) then + call prep_atm_calc_z2x_ax(fractions_zx, timer='CPL:atmprep_iac2atm') + endif if (associated(xao_ax)) then call prep_atm_mrg(infodata, fractions_ax, xao_ax=xao_ax, timer_mrg='CPL:atmprep_mrgx2a') endif @@ -3563,7 +3692,7 @@ subroutine cime_run_ocn_setup_send() end subroutine cime_run_ocn_setup_send -!---------------------------------------------------------------------------------- + !---------------------------------------------------------------------------------- subroutine cime_run_ocn_recv_post() @@ -3595,7 +3724,94 @@ subroutine cime_run_ocn_recv_post() end subroutine cime_run_ocn_recv_post -!---------------------------------------------------------------------------------- + !---------------------------------------------------------------------------------- + subroutine cime_run_iac_setup_send() + + !------------------------------------------------------- + ! | iac prep-merge + !------------------------------------------------------- + + if (iamin_CPLID .and. iac_prognostic) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:IACPREP_BARRIER') + + call t_drvstartf ('CPL:IACPREP', cplrun=.true., barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + ! Average our accumulators + call prep_iac_accum_avg(timer='CPL:iacprep_l2xavg') + + ! Setup lnd inputs on iac grid. Right now I think they will be the same + ! thing, but I'm trying to code for the general case + if (lnd_c2_iac) then + call prep_iac_calc_l2x_zx(timer='CPL:iacprep_lnd2iac') + endif + + + call prep_iac_mrg(infodata, fractions_zx, timer_mrg='CPL:iacprep_mrgx2z') + + call component_diag(infodata, iac, flow='x2c', comment= 'send iac', & + info_debug=info_debug, timer_diag='CPL:iacprep_diagav') + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:IACPREP',cplrun=.true.) + endif + + !---------------------------------------------------- + !| cpl -> iac + !---------------------------------------------------- + + if (iamin_CPLALLIACID .and. iac_prognostic) then + call component_exch(iac, flow='x2c', & + infodata=infodata, infodata_string='cpl2iac_run', & + mpicom_barrier=mpicom_CPLALLLNDID, run_barriers=run_barriers, & + timer_barrier='CPL:C2Z_BARRIER', timer_comp_exch='CPL:C2Z', & + timer_map_exch='CPL:c2z_iacx2iacr', timer_infodata_exch='CPL:c2z_infoexch') + endif + + end subroutine cime_run_iac_setup_send + + !---------------------------------------------------------------------------------- + subroutine cime_run_iac_recv_post() + + !---------------------------------------------------------- + !| iac -> cpl + !---------------------------------------------------------- + + if (iamin_CPLALLIACID) then + call component_exch(rof, flow='c2x', & + infodata=infodata, infodata_string='iac2cpl_run', & + mpicom_barrier=mpicom_CPLALLIACID, run_barriers=run_barriers, & + timer_barrier='CPL:Z2C_BARRIER', timer_comp_exch='CPL:Z2C', & + timer_map_exch='CPL:z2c_iacr2iacx', timer_infodata_exch='CPL:z2c_infoexch') + endif + + !---------------------------------------------------------- + !| iac post + !---------------------------------------------------------- + + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:IACPOST_BARRIER') + call t_drvstartf ('CPL:IACPOST',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + call component_diag(infodata, iac, flow='c2x', comment= 'recv iac', & + info_debug=info_debug, timer_diag='CPL:iacpost_diagav') + + ! TRS I think this is wrong - review these prep functions. I think it's more likely + if (iac_c2_lnd) then + call prep_lnd_calc_z2x_lx(timer='CPL:iacpost_iac2lnd') + endif + + if (iac_c2_atm) then + call prep_atm_calc_z2x_ax(fractions_zx, timer='CPL:iacpost_iac2atm') + endif + + call t_drvstopf ('CPL:IACPOST', cplrun=.true.) + endif + + end subroutine cime_run_iac_recv_post + + !---------------------------------------------------------------------------------- subroutine cime_run_atmocn_setup(hashint) integer, intent(inout) :: hashint(:) @@ -3668,6 +3884,11 @@ subroutine cime_run_lnd_setup_send() if (glc_c2_lnd) call prep_lnd_calc_g2x_lx(timer='CPL:glcpost_glc2lnd') end if + ! IAC export onto lnd grid + if (iac_c2_lnd) then + call prep_lnd_calc_z2x_lx(timer='CPL:lndprep_iac2lnd') + endif + if (lnd_prognostic) then call prep_lnd_mrg(infodata, timer_mrg='CPL:lndprep_mrgx2l') @@ -3719,7 +3940,8 @@ subroutine cime_run_lnd_recv_post() ! Accumulate rof and glc inputs (module variables in prep_rof_mod and prep_glc_mod) if (lnd_c2_rof) call prep_rof_accum(timer='CPL:lndpost_accl2r') - if (lnd_c2_glc) call prep_glc_accum(timer='CPL:lndpost_accl2g' ) + if (lnd_c2_glc) call prep_glc_accum(timer='CPL:lndpost_accl2g') + if (lnd_c2_iac) call prep_iac_accum(timer='CPL:lndpost_accl2z') if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) call t_drvstopf ('CPL:LNDPOST',cplrun=.true.) @@ -4180,16 +4402,16 @@ subroutine cime_run_write_history() endif call seq_hist_write(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, & + atm, lnd, ice, ocn, rof, glc, wav, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx, trim(cpl_inst_tag)) + fractions_rx, fractions_gx, fractions_wx, fractions_zx, trim(cpl_inst_tag)) if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) endif if (do_histavg) then call seq_hist_writeavg(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, histavg_alarm, & + atm, lnd, ice, ocn, rof, glc, wav, iac, histavg_alarm, & trim(cpl_inst_tag)) endif @@ -4226,9 +4448,9 @@ subroutine cime_run_write_restart(drv_pause, write_restart, drv_resume) endif call seq_rest_write(EClock_d, seq_SyncClock, infodata, & - atm, lnd, ice, ocn, rof, glc, wav, esp, & + atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx, & + fractions_rx, fractions_gx, fractions_wx, fractions_zx, & trim(cpl_inst_tag), drv_resume) if (iamroot_CPLID) then diff --git a/src/drivers/mct/main/component_mod.F90 b/src/drivers/mct/main/component_mod.F90 index 983b7af698db..3c9e6da2c33e 100644 --- a/src/drivers/mct/main/component_mod.F90 +++ b/src/drivers/mct/main/component_mod.F90 @@ -123,7 +123,15 @@ subroutine component_init_pre(comp, compid, cplcompid, cplallcompid, & comp(eci)%suffix = seq_comm_suffix(comp(eci)%compid) comp(eci)%name = seq_comm_name (comp(eci)%compid) comp(eci)%ntype = ntype(1:3) - comp(eci)%oneletterid = ntype(1:1) + + select case(ntype) + case ('atm','cpl','ocn','wav','glc','ice','rof','lnd','esp') + comp(eci)%oneletterid = ntype(1:1) + case ('iac') + comp(eci)%oneletterid = 'z' + case default + call shr_sys_abort(subname//': ntype, "'//ntype//'" not recognized"') + end select if (eci == 1) then allocate(comp(1)%dom_cx) @@ -167,6 +175,9 @@ subroutine component_init_pre(comp, compid, cplcompid, cplallcompid, & if (comp(1)%oneletterid == 'e') then call seq_infodata_getData(infodata, esp_present=comp(eci)%present) end if + if (comp(1)%oneletterid == 'z') then + call seq_infodata_getData(infodata, iac_present=comp(eci)%present) + end if #else call seq_infodata_getData(comp(1)%oneletterid, infodata, comp_present=comp(eci)%present) #endif @@ -277,6 +288,7 @@ end subroutine comp_init if (comp(1)%oneletterid == 'g') call seq_infodata_getData(infodata, glc_present=comp(eci)%present) if (comp(1)%oneletterid == 'w') call seq_infodata_getData(infodata, wav_present=comp(eci)%present) if (comp(1)%oneletterid == 'e') call seq_infodata_getData(infodata, esp_present=comp(eci)%present) + if (comp(1)%oneletterid == 'z') call seq_infodata_getData(infodata, iac_present=comp(eci)%present) #else call seq_infodata_getData(comp(1)%oneletterid, infodata, comp_present=comp(eci)%present) #endif @@ -693,6 +705,7 @@ end subroutine comp_run if (comp(1)%oneletterid == 'g') call seq_infodata_putData(infodata, glc_phase=phase) if (comp(1)%oneletterid == 'w') call seq_infodata_putData(infodata, wav_phase=phase) if (comp(1)%oneletterid == 'e') call seq_infodata_putData(infodata, esp_phase=phase) + if (comp(1)%oneletterid == 'z') call seq_infodata_putData(infodata, iac_phase=phase) #else call seq_infodata_putData(comp(1)%oneletterid, infodata, comp_phase=phase) #endif diff --git a/src/drivers/mct/main/component_type_mod.F90 b/src/drivers/mct/main/component_type_mod.F90 index d1cd710946a3..6d222c8a1d54 100644 --- a/src/drivers/mct/main/component_type_mod.F90 +++ b/src/drivers/mct/main/component_type_mod.F90 @@ -12,7 +12,7 @@ module component_type_mod use seq_comm_mct , only: seq_comm_namelen use seq_comm_mct , only: num_inst_atm, num_inst_lnd, num_inst_rof use seq_comm_mct , only: num_inst_ocn, num_inst_ice, num_inst_glc - use seq_comm_mct , only: num_inst_wav, num_inst_esp + use seq_comm_mct , only: num_inst_wav, num_inst_esp, num_inst_iac use mct_mod implicit none @@ -112,8 +112,9 @@ module component_type_mod type(component_type), target :: glc(num_inst_glc) type(component_type), target :: wav(num_inst_wav) type(component_type), target :: esp(num_inst_esp) + type(component_type), target :: iac(num_inst_iac) - public :: atm, lnd, rof, ocn, ice, glc, wav, esp + public :: atm, lnd, rof, ocn, ice, glc, wav, esp, iac !=============================================================================== diff --git a/src/drivers/mct/main/prep_atm_mod.F90 b/src/drivers/mct/main/prep_atm_mod.F90 index fdd2a713180f..4fcf079b785f 100644 --- a/src/drivers/mct/main/prep_atm_mod.F90 +++ b/src/drivers/mct/main/prep_atm_mod.F90 @@ -31,10 +31,12 @@ module prep_atm_mod public :: prep_atm_get_l2x_ax public :: prep_atm_get_i2x_ax public :: prep_atm_get_o2x_ax + public :: prep_atm_get_z2x_ax public :: prep_atm_calc_l2x_ax public :: prep_atm_calc_i2x_ax public :: prep_atm_calc_o2x_ax + public :: prep_atm_calc_z2x_ax public :: prep_atm_get_mapper_So2a public :: prep_atm_get_mapper_Fo2a @@ -65,6 +67,7 @@ module prep_atm_mod type(mct_aVect), pointer :: l2x_ax(:) ! Lnd export, atm grid, cpl pes - allocated in driver type(mct_aVect), pointer :: i2x_ax(:) ! Ice export, atm grid, cpl pes - allocated in driver type(mct_aVect), pointer :: o2x_ax(:) ! Ocn export, atm grid, cpl pes - allocated in driver + type(mct_aVect), pointer :: z2x_ax(:) ! Iac export, atm grid, cpl pes - allocated in driver ! other module variables integer :: mpicom_CPLID ! MPI cpl communicator @@ -75,7 +78,7 @@ module prep_atm_mod !================================================================================================ - subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm) + subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_atm) !--------------------------------------------------------------- ! Description @@ -86,6 +89,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm) logical , intent(in) :: ocn_c2_atm ! .true. => ocn to atm coupling on logical , intent(in) :: ice_c2_atm ! .true. => ice to atm coupling on logical , intent(in) :: lnd_c2_atm ! .true. => lnd to atm coupling on + logical , intent(in) :: iac_c2_atm ! .true. => iac to atm coupling on ! ! Local Variables integer :: lsize_a @@ -739,6 +743,21 @@ end subroutine prep_atm_calc_l2x_ax !================================================================================================ + subroutine prep_atm_calc_z2x_ax(fractions_zx, timer) + !--------------------------------------------------------------- + ! Description + ! Create z2x_ax (note that z2x_ax is a local module variable) + ! + ! Arguments + type(mct_aVect) , intent(in) :: fractions_zx(:) + character(len=*), intent(in) :: timer + ! + ! Local Variables + + end subroutine prep_atm_calc_z2x_ax + + !================================================================================================ + function prep_atm_get_l2x_ax() type(mct_aVect), pointer :: prep_atm_get_l2x_ax(:) prep_atm_get_l2x_ax => l2x_ax(:) @@ -754,6 +773,11 @@ function prep_atm_get_o2x_ax() prep_atm_get_o2x_ax => o2x_ax(:) end function prep_atm_get_o2x_ax + function prep_atm_get_z2x_ax() + type(mct_aVect), pointer :: prep_atm_get_z2x_ax(:) + prep_atm_get_z2x_ax => z2x_ax(:) + end function prep_atm_get_z2x_ax + function prep_atm_get_mapper_So2a() type(seq_map), pointer :: prep_atm_get_mapper_So2a prep_atm_get_mapper_So2a => mapper_So2a diff --git a/src/drivers/mct/main/prep_iac_mod.F90 b/src/drivers/mct/main/prep_iac_mod.F90 new file mode 100644 index 000000000000..1ab5f6d02848 --- /dev/null +++ b/src/drivers/mct/main/prep_iac_mod.F90 @@ -0,0 +1,168 @@ +module prep_iac_mod + +#include "shr_assert.h" + use shr_kind_mod, only: r8 => SHR_KIND_R8 + use shr_kind_mod, only: cs => SHR_KIND_CS + use shr_kind_mod, only: cl => SHR_KIND_CL + use shr_kind_mod, only: cxx => SHR_KIND_CXX + use shr_sys_mod, only: shr_sys_abort, shr_sys_flush + use seq_comm_mct, only: num_inst_lnd, num_inst_iac, num_inst_frc + use seq_comm_mct, only: CPLID, ROFID, logunit + use seq_comm_mct, only: seq_comm_getData=>seq_comm_setptrs + use seq_infodata_mod, only: seq_infodata_type, seq_infodata_getdata + use shr_log_mod , only: errMsg => shr_log_errMsg + use seq_map_type_mod + use seq_map_mod + use seq_flds_mod + use t_drv_timers_mod + use mct_mod + use perf_mod + use component_type_mod, only: component_get_x2c_cx, component_get_c2x_cx + use component_type_mod, only: iac, lnd + use prep_lnd_mod, only: prep_lnd_get_mapper_Fr2l + + implicit none + save + private + + !-------------------------------------------------------------------------- + ! Public interfaces + !-------------------------------------------------------------------------- + + public :: prep_iac_init + public :: prep_iac_mrg + + public :: prep_iac_accum + public :: prep_iac_accum_avg + + public :: prep_iac_calc_l2x_zx + + public :: prep_iac_get_l2zacc_lx + public :: prep_iac_get_l2zacc_lx_cnt + public :: prep_iac_get_mapper_Fl2z + + !-------------------------------------------------------------------------- + ! Private interfaces + !-------------------------------------------------------------------------- + + !-------------------------------------------------------------------------- + ! Private data + !-------------------------------------------------------------------------- + + ! mappers + type(seq_map), pointer :: mapper_Fl2z + + ! attribute vectors + type(mct_aVect), pointer :: l2x_zx(:) + + ! accumulation variables + type(mct_aVect), pointer :: l2zacc_lx(:) ! lnd export, lnd grid, cpl pes + integer , target :: l2zacc_lx_cnt ! l2racc_lx: number of time samples accumulated + + ! other module variables + integer :: mpicom_CPLID ! MPI cpl communicator + + !================================================================================================ + +contains + + !================================================================================================ + + subroutine prep_iac_init(infodata, lnd_c2_iac) + + !--------------------------------------------------------------- + ! Description + ! Initialize module attribute vectors and all other non-mapping + ! module variables + ! + ! Arguments + type(seq_infodata_type) , intent(in) :: infodata + logical , intent(in) :: lnd_c2_iac ! .true. => lnd to iac coupling on + ! + ! Local Variables + + end subroutine prep_iac_init + + !================================================================================================ + + subroutine prep_iac_accum(timer) + + !--------------------------------------------------------------- + ! Description + ! Accumulate land input to iac + ! + ! Arguments + character(len=*), intent(in) :: timer + ! + ! Local Variables + + end subroutine prep_iac_accum + + !================================================================================================ + + subroutine prep_iac_accum_avg(timer) + + !--------------------------------------------------------------- + ! Description + ! Finalize accumulation of land input to river component + ! + ! Arguments + character(len=*), intent(in) :: timer + ! + ! Local Variables + + end subroutine prep_iac_accum_avg + + !================================================================================================ + + subroutine prep_iac_mrg(infodata, fractions_zx, timer_mrg) + + !--------------------------------------------------------------- + ! Description + ! Merge iac inputs + ! + ! Arguments + type(seq_infodata_type) , intent(in) :: infodata + type(mct_aVect) , intent(in) :: fractions_zx(:) + character(len=*) , intent(in) :: timer_mrg + ! + ! Local Variables + + end subroutine prep_iac_mrg + + !================================================================================================ + + !================================================================================================ + + subroutine prep_iac_calc_l2x_zx(timer) + !--------------------------------------------------------------- + ! Description + ! Create l2x_zx (note that l2x_zx is a local module variable) + ! + ! Arguments + ! Don't know if we need these fractions just yet + ! type(mct_aVect) , intent(in) :: fractions_lx(:) + character(len=*), intent(in) :: timer + ! + ! Local Variables + + end subroutine prep_iac_calc_l2x_zx + + !================================================================================================ + + function prep_iac_get_l2zacc_lx() + type(mct_aVect), pointer :: prep_iac_get_l2zacc_lx(:) + prep_iac_get_l2zacc_lx => l2zacc_lx(:) + end function prep_iac_get_l2zacc_lx + + function prep_iac_get_l2zacc_lx_cnt() + integer, pointer :: prep_iac_get_l2zacc_lx_cnt + prep_iac_get_l2zacc_lx_cnt => l2zacc_lx_cnt + end function prep_iac_get_l2zacc_lx_cnt + + function prep_iac_get_mapper_Fl2z() + type(seq_map), pointer :: prep_iac_get_mapper_Fl2z + prep_iac_get_mapper_Fl2z => mapper_Fl2z + end function prep_iac_get_mapper_Fl2z + +end module prep_iac_mod diff --git a/src/drivers/mct/main/prep_lnd_mod.F90 b/src/drivers/mct/main/prep_lnd_mod.F90 index b65df6a4211c..344637f3fdcf 100644 --- a/src/drivers/mct/main/prep_lnd_mod.F90 +++ b/src/drivers/mct/main/prep_lnd_mod.F90 @@ -34,10 +34,12 @@ module prep_lnd_mod public :: prep_lnd_calc_a2x_lx public :: prep_lnd_calc_r2x_lx public :: prep_lnd_calc_g2x_lx + public :: prep_lnd_calc_z2x_lx public :: prep_lnd_get_a2x_lx public :: prep_lnd_get_r2x_lx public :: prep_lnd_get_g2x_lx + public :: prep_lnd_get_z2x_lx public :: prep_lnd_get_mapper_Sa2l public :: prep_lnd_get_mapper_Fa2l @@ -67,6 +69,7 @@ module prep_lnd_mod type(mct_aVect), pointer :: a2x_lx(:) ! Atm export, lnd grid, cpl pes - allocated in driver type(mct_aVect), pointer :: r2x_lx(:) ! Rof export, lnd grid, lnd pes - allocated in lnd gc type(mct_aVect), pointer :: g2x_lx(:) ! Glc export, lnd grid, cpl pes - allocated in driver + type(mct_aVect), pointer :: z2x_lx(:) ! Iac export, lnd grid, cpl pes - allocated in driver ! seq_comm_getData variables integer :: mpicom_CPLID ! MPI cpl communicator @@ -86,7 +89,7 @@ module prep_lnd_mod !================================================================================================ - subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd) + subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_lnd) !--------------------------------------------------------------- ! Description @@ -98,6 +101,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd) logical , intent(in) :: atm_c2_lnd ! .true. => atm to lnd coupling on logical , intent(in) :: rof_c2_lnd ! .true. => rof to lnd coupling on logical , intent(in) :: glc_c2_lnd ! .true. => glc to lnd coupling on + logical , intent(in) :: iac_c2_lnd ! .true. => iac to lnd coupling on ! ! Local Variables integer :: lsize_l @@ -477,6 +481,26 @@ end subroutine prep_lnd_calc_g2x_lx !================================================================================================ + subroutine prep_lnd_calc_z2x_lx(timer) + !--------------------------------------------------------------- + ! Description + ! Create z2x_lx (note that z2x_lx is a local module variable) + ! + ! Arguments + character(len=*) , intent(in) :: timer + ! + ! Local Variables + integer :: egi + type(mct_aVect), pointer :: z2x_gx + character(*), parameter :: subname = '(prep_lnd_calc_z2x_lx)' + !--------------------------------------------------------------- + + ! Stub + + end subroutine prep_lnd_calc_z2x_lx + + !================================================================================================ + function prep_lnd_get_a2x_lx() type(mct_aVect), pointer :: prep_lnd_get_a2x_lx(:) prep_lnd_get_a2x_lx => a2x_lx(:) @@ -492,6 +516,11 @@ function prep_lnd_get_g2x_lx() prep_lnd_get_g2x_lx => g2x_lx(:) end function prep_lnd_get_g2x_lx + function prep_lnd_get_z2x_lx() + type(mct_aVect), pointer :: prep_lnd_get_z2x_lx(:) + prep_lnd_get_z2x_lx => z2x_lx(:) + end function prep_lnd_get_z2x_lx + function prep_lnd_get_mapper_Sa2l() type(seq_map), pointer :: prep_lnd_get_mapper_Sa2l prep_lnd_get_mapper_Sa2l => mapper_Sa2l diff --git a/src/drivers/mct/main/seq_frac_mct.F90 b/src/drivers/mct/main/seq_frac_mct.F90 index 3793ca31e35c..11985ab9a58a 100644 --- a/src/drivers/mct/main/seq_frac_mct.F90 +++ b/src/drivers/mct/main/seq_frac_mct.F90 @@ -217,9 +217,10 @@ module seq_frac_mct ! !INTERFACE: ------------------------------------------------------------------ subroutine seq_frac_init( infodata, & - atm, ice, lnd, ocn, glc, rof, wav, & + atm, ice, lnd, ocn, glc, rof, wav, iac,& fractions_a, fractions_i, fractions_l, & - fractions_o, fractions_g, fractions_r, fractions_w) + fractions_o, fractions_g, fractions_r, & + fractions_w, fractions_z) ! !INPUT/OUTPUT PARAMETERS: type(seq_infodata_type) , intent(in) :: infodata @@ -230,6 +231,7 @@ subroutine seq_frac_init( infodata, & type(component_type) , intent(in) :: glc type(component_type) , intent(in) :: rof type(component_type) , intent(in) :: wav + type(component_type) , intent(in) :: iac type(mct_aVect) , intent(inout) :: fractions_a ! Fractions on atm grid/decomp type(mct_aVect) , intent(inout) :: fractions_i ! Fractions on ice grid/decomp type(mct_aVect) , intent(inout) :: fractions_l ! Fractions on lnd grid/decomp @@ -237,6 +239,7 @@ subroutine seq_frac_init( infodata, & type(mct_aVect) , intent(inout) :: fractions_g ! Fractions on glc grid/decomp type(mct_aVect) , intent(inout) :: fractions_r ! Fractions on rof grid/decomp type(mct_aVect) , intent(inout) :: fractions_w ! Fractions on wav grid/decomp + type(mct_aVect) , intent(inout) :: fractions_z ! Fractions on iac grid/decomp !EOP !----- local ----- @@ -247,6 +250,7 @@ subroutine seq_frac_init( infodata, & type(mct_ggrid), pointer :: dom_g type(mct_ggrid), pointer :: dom_r type(mct_ggrid), pointer :: dom_w + type(mct_ggrid), pointer :: dom_z logical :: atm_present ! .true. => atm is present logical :: ice_present ! .true. => ice is present @@ -255,6 +259,7 @@ subroutine seq_frac_init( infodata, & logical :: glc_present ! .true. => glc is present logical :: rof_present ! .true. => rof is present logical :: wav_present ! .true. => wav is present + logical :: iac_present ! .true. => iac is present logical :: dead_comps ! .true. => dead models present integer :: n ! indices @@ -270,6 +275,7 @@ subroutine seq_frac_init( infodata, & character(*),parameter :: fraclist_g = 'gfrac:lfrac' character(*),parameter :: fraclist_r = 'lfrac:rfrac' character(*),parameter :: fraclist_w = 'wfrac' + character(*),parameter :: fraclist_z = 'afrac:lfrac' !----- formats ----- character(*),parameter :: subName = '(seq_frac_init) ' @@ -286,6 +292,7 @@ subroutine seq_frac_init( infodata, & ocn_present=ocn_present, & glc_present=glc_present, & wav_present=wav_present, & + iac_present=iac_present, & dead_comps=dead_comps) dom_a => component_get_dom_cx(atm) @@ -295,6 +302,7 @@ subroutine seq_frac_init( infodata, & dom_r => component_get_dom_cx(rof) dom_g => component_get_dom_cx(glc) dom_w => component_get_dom_cx(wav) + dom_z => component_get_dom_cx(iac) debug_old = seq_frac_debug seq_frac_debug = 2 @@ -363,6 +371,15 @@ subroutine seq_frac_init( infodata, & fractions_w%rAttr(:,:) = 1.0_r8 end if + ! Initialize fractions on iac grid decomp, just an initial "guess", updated later + + if (iac_present) then + lSize = mct_aVect_lSize(dom_z%data) + call mct_aVect_init(fractions_z,rList=fraclist_z,lsize=lsize) + call mct_aVect_zero(fractions_z) + fractions_z%rAttr(:,:) = 1.0_r8 + end if + ! Initialize fractions on ice grid/decomp (initialize ice fraction to zero) if (ice_present) then @@ -471,6 +488,7 @@ subroutine seq_frac_init( infodata, & if (glc_present) call seq_frac_check(fractions_g,'glc init') if (rof_present) call seq_frac_check(fractions_r,'rof init') if (wav_present) call seq_frac_check(fractions_w,'wav init') + if (iac_present) call seq_frac_check(fractions_z,'iac init') if (ice_present) call seq_frac_check(fractions_i,'ice init') if (ocn_present) call seq_frac_check(fractions_o,'ocn init') if (atm_present .and. (lnd_present.or.ice_present.or.ocn_present)) & @@ -621,11 +639,12 @@ subroutine seq_frac_check(fractions,string) real(r8) :: gminval,gmaxval ! used for glc real(r8) :: rminval,rmaxval ! used for rof real(r8) :: wminval,wmaxval ! used for wav + real(r8) :: zminval,zmaxval ! used for iac real(r8) :: kminval,kmaxval ! used for lnd, lfrin real(r8) :: sminval,smaxval ! used for sum real(r8) :: tmpmin, tmpmax ! global tmps integer :: tmpsum ! global tmp - integer :: ka,kl,ki,ko,kg,kk,kr,kw + integer :: ka,kl,ki,ko,kg,kk,kr,kw,kz character(len=128) :: lstring logical :: error @@ -655,6 +674,7 @@ subroutine seq_frac_check(fractions,string) kg = -1 kr = -1 kw = -1 + kz = -1 aminval = 999.0_r8 amaxval = -999.0_r8 lminval = 999.0_r8 @@ -673,6 +693,8 @@ subroutine seq_frac_check(fractions,string) rmaxval = -999.0_r8 wminval = 999.0_r8 wmaxval = -999.0_r8 + zminval = 999.0_r8 + zmaxval = -999.0_r8 lsize = mct_avect_lsize(fractions) ka = mct_aVect_indexRA(fractions,"afrac",perrWith='quiet') @@ -682,6 +704,7 @@ subroutine seq_frac_check(fractions,string) kg = mct_aVect_indexRA(fractions,"gfrac",perrWith='quiet') kr = mct_aVect_indexRA(fractions,"rfrac",perrWith='quiet') kw = mct_aVect_indexRA(fractions,"wfrac",perrWith='quiet') + kz = mct_aVect_indexRA(fractions,"zfrac",perrWith='quiet') kk = mct_aVect_indexRA(fractions,"lfrin",perrWith='quiet') if (ka > 0) then @@ -712,6 +735,10 @@ subroutine seq_frac_check(fractions,string) wminval = minval(fractions%rAttr(kw,:)) wmaxval = maxval(fractions%rAttr(kw,:)) endif + if (kz > 0) then + zminval = minval(fractions%rAttr(kz,:)) + zmaxval = maxval(fractions%rAttr(kz,:)) + endif if (kk > 0) then kminval = minval(fractions%rAttr(kk,:)) kmaxval = maxval(fractions%rAttr(kk,:)) @@ -743,6 +770,7 @@ subroutine seq_frac_check(fractions,string) if (gminval < 0.0_r8-eps_fracval .or. gmaxval > 1.0_r8+eps_fracval) error = .true. if (rminval < 0.0_r8-eps_fracval .or. rmaxval > 1.0_r8+eps_fracval) error = .true. if (wminval < 0.0_r8-eps_fracval .or. wmaxval > 1.0_r8+eps_fracval) error = .true. + if (zminval < 0.0_r8-eps_fracval .or. zmaxval > 1.0_r8+eps_fracval) error = .true. if (kminval < 0.0_r8-eps_fracval .or. kmaxval > 1.0_r8+eps_fracval) error = .true. if (error .or. seq_frac_debug > 1) then @@ -781,6 +809,11 @@ subroutine seq_frac_check(fractions,string) call shr_mpi_max(wmaxval,tmpmax,mpicom,subname//':wfrac',all=.false.) if (iamroot) write(logunit,F02) trim(lstring),' wfrac min/max = ',tmpmin,tmpmax endif + if (kz > 0) then + call shr_mpi_min(kminval,tmpmin,mpicom,subname//':zfrac',all=.false.) + call shr_mpi_max(kmaxval,tmpmax,mpicom,subname//':zfrac',all=.false.) + if (iamroot) write(logunit,F02) trim(lstring),' zfrac min/max = ',tmpmin,tmpmax + endif if (kk > 0) then call shr_mpi_min(kminval,tmpmin,mpicom,subname//':lfrin',all=.false.) call shr_mpi_max(kmaxval,tmpmax,mpicom,subname//':lfrin',all=.false.) diff --git a/src/drivers/mct/main/seq_hist_mod.F90 b/src/drivers/mct/main/seq_hist_mod.F90 index 076d41819b2e..433854932003 100644 --- a/src/drivers/mct/main/seq_hist_mod.F90 +++ b/src/drivers/mct/main/seq_hist_mod.F90 @@ -30,7 +30,7 @@ module seq_hist_mod use seq_comm_mct, only: CPLID, GLOID, logunit, loglevel use seq_comm_mct, only: num_inst_atm, num_inst_lnd, num_inst_ocn use seq_comm_mct, only: num_inst_ice, num_inst_glc, num_inst_wav - use seq_comm_mct, only: num_inst_rof, num_inst_xao + use seq_comm_mct, only: num_inst_rof, num_inst_xao, num_inst_iac use prep_ocn_mod, only: prep_ocn_get_r2x_ox use prep_ocn_mod, only: prep_ocn_get_x2oacc_ox @@ -81,6 +81,7 @@ module seq_hist_mod logical :: rof_present ! .true. => land runoff is present logical :: glc_present ! .true. => glc is present logical :: wav_present ! .true. => wav is present + logical :: iac_present ! .true. => iac is present logical :: atm_prognostic ! .true. => atm comp expects input logical :: lnd_prognostic ! .true. => lnd comp expects input @@ -90,6 +91,7 @@ module seq_hist_mod logical :: rof_prognostic ! .true. => rof comp expects input logical :: glc_prognostic ! .true. => glc comp expects input logical :: wav_prognostic ! .true. => wav comp expects input + logical :: iac_prognostic ! .true. => iac comp expects input logical :: histavg_atm ! .true. => write atm fields to average history file logical :: histavg_lnd ! .true. => write lnd fields to average history file @@ -98,6 +100,7 @@ module seq_hist_mod logical :: histavg_rof ! .true. => write rof fields to average history file logical :: histavg_glc ! .true. => write glc fields to average history file logical :: histavg_wav ! .true. => write wav fields to average history file + logical :: histavg_iac ! .true. => write iac fields to average history file logical :: histavg_xao ! .true. => write flux xao fields to average history file logical :: single_column @@ -110,6 +113,7 @@ module seq_hist_mod integer(IN) :: rof_nx, rof_ny ! nx,ny of 2d grid, if known integer(IN) :: glc_nx, glc_ny ! nx,ny of 2d grid, if known integer(IN) :: wav_nx, wav_ny ! nx,ny of 2d grid, if known + integer(IN) :: iac_nx, iac_ny ! nx,ny of 2d grid, if known !--- temporary pointers --- type(mct_aVect), pointer :: r2x_ox(:) @@ -124,9 +128,9 @@ module seq_hist_mod !=============================================================================== subroutine seq_hist_write(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, & + atm, lnd, ice, ocn, rof, glc, wav, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, fractions_rx, & - fractions_gx, fractions_wx, cpl_inst_tag) + fractions_gx, fractions_wx, fractions_zx, cpl_inst_tag) implicit none ! @@ -140,6 +144,7 @@ subroutine seq_hist_write(infodata, EClock_d, & type (component_type) , intent(inout) :: rof(:) type (component_type) , intent(inout) :: glc(:) type (component_type) , intent(inout) :: wav(:) + type (component_type) , intent(inout) :: iac(:) type(mct_aVect) , intent(inout) :: fractions_ax(:) ! Fractions on atm grid/decomp type(mct_aVect) , intent(inout) :: fractions_lx(:) ! Fractions on lnd grid/decomp type(mct_aVect) , intent(inout) :: fractions_ix(:) ! Fractions on ice grid/decomp @@ -147,6 +152,7 @@ subroutine seq_hist_write(infodata, EClock_d, & type(mct_aVect) , intent(inout) :: fractions_rx(:) ! Fractions on rof grid/decomp type(mct_aVect) , intent(inout) :: fractions_gx(:) ! Fractions on glc grid/decomp type(mct_aVect) , intent(inout) :: fractions_wx(:) ! Fractions on wav grid/decomp + type(mct_aVect) , intent(inout) :: fractions_zx(:) ! Fractions on iac grid/decomp character(len=*) , intent(in) :: cpl_inst_tag ! ! Local Variables @@ -187,6 +193,7 @@ subroutine seq_hist_write(infodata, EClock_d, & ocn_present=ocn_present, & glc_present=glc_present, & wav_present=wav_present, & + iac_present=iac_present, & atm_prognostic=atm_prognostic, & lnd_prognostic=lnd_prognostic, & ice_prognostic=ice_prognostic, & @@ -195,12 +202,14 @@ subroutine seq_hist_write(infodata, EClock_d, & rof_prognostic=rof_prognostic, & glc_prognostic=glc_prognostic, & wav_prognostic=wav_prognostic, & + iac_prognostic=iac_prognostic, & atm_nx=atm_nx, atm_ny=atm_ny, & lnd_nx=lnd_nx, lnd_ny=lnd_ny, & rof_nx=rof_nx, rof_ny=rof_ny, & ice_nx=ice_nx, ice_ny=ice_ny, & glc_nx=glc_nx, glc_ny=glc_ny, & wav_nx=wav_nx, wav_ny=wav_ny, & + iac_nx=iac_nx, iac_ny=iac_ny, & ocn_nx=ocn_nx, ocn_ny=ocn_ny, & single_column=single_column, & case_name=case_name, & @@ -381,6 +390,19 @@ subroutine seq_hist_write(infodata, EClock_d, & call seq_io_write(hist_file, wav, 'x2c', 'x2w_wx', & nx=wav_nx, ny=wav_ny, nt=1, whead=whead, wdata=wdata, pre='x2w') endif + + if (iac_present) then + gsmap => component_get_gsmap_cx(iac(1)) + dom => component_get_dom_cx(iac(1)) + call seq_io_write(hist_file, gsmap, dom%data, 'dom_zx', & + nx=iac_nx, ny=iac_ny, nt=1, whead=whead, wdata=wdata, pre='domz') + call seq_io_write(hist_file, gsmap, fractions_zx, 'fractions_zx', & + nx=iac_nx, ny=iac_ny, nt=1, whead=whead, wdata=wdata, pre='fracz') + call seq_io_write(hist_file, iac, 'c2x', 'z2x_zx', & + nx=iac_nx, ny=iac_ny, nt=1, whead=whead, wdata=wdata, pre='w2x') + call seq_io_write(hist_file, iac, 'x2c', 'x2z_zx', & + nx=iac_nx, ny=iac_ny, nt=1, whead=whead, wdata=wdata, pre='x2w') + endif enddo call seq_io_close(hist_file) @@ -392,7 +414,7 @@ end subroutine seq_hist_write !=============================================================================== subroutine seq_hist_writeavg(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, write_now, cpl_inst_tag) + atm, lnd, ice, ocn, rof, glc, wav, iac, write_now, cpl_inst_tag) implicit none @@ -405,6 +427,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & type (component_type) , intent(in) :: rof(:) type (component_type) , intent(in) :: glc(:) type (component_type) , intent(in) :: wav(:) + type (component_type) , intent(in) :: iac(:) logical , intent(in) :: write_now ! write or accumulate character(len=*) , intent(in) :: cpl_inst_tag @@ -441,6 +464,8 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & type(mct_aVect), save :: x2g_gx_avg(num_inst_glc) type(mct_aVect), save :: w2x_wx_avg(num_inst_wav) type(mct_aVect), save :: x2w_wx_avg(num_inst_wav) + type(mct_aVect), save :: z2x_zx_avg(num_inst_iac) + type(mct_aVect), save :: x2z_zx_avg(num_inst_iac) type(mct_aVect), save, pointer :: xao_ox_avg(:) type(mct_aVect), save, pointer :: xao_ax_avg(:) @@ -477,6 +502,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & ocn_present=ocn_present, & glc_present=glc_present, & wav_present=wav_present, & + iac_present=iac_present, & atm_prognostic=atm_prognostic, & lnd_prognostic=lnd_prognostic, & ice_prognostic=ice_prognostic, & @@ -490,6 +516,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & ice_nx=ice_nx, ice_ny=ice_ny, & glc_nx=glc_nx, glc_ny=glc_ny, & wav_nx=wav_nx, wav_ny=wav_ny, & + iac_nx=iac_nx, iac_ny=iac_ny, & ocn_nx=ocn_nx, ocn_ny=ocn_ny, & histavg_atm=histavg_atm, & histavg_lnd=histavg_lnd, & @@ -498,6 +525,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & histavg_rof=histavg_rof, & histavg_glc=histavg_glc, & histavg_wav=histavg_wav, & + histavg_iac=histavg_iac, & histavg_xao=histavg_xao, & model_doi_url=model_doi_url) @@ -599,6 +627,19 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & call mct_aVect_zero(x2w_wx_avg(iidx)) enddo endif + if (iac_present .and. histavg_iac) then + do iidx = 1, num_inst_iac + c2x => component_get_c2x_cx(iac(iidx)) + lsize = mct_aVect_lsize(c2x) + call mct_aVect_init(z2x_zx_avg(iidx), c2x, lsize) + call mct_aVect_zero(z2x_zx_avg(iidx)) + + x2c => component_get_x2c_cx(iac(iidx)) + lsize = mct_aVect_lsize(x2c) + call mct_aVect_init(x2z_zx_avg(iidx), x2c, lsize) + call mct_aVect_zero(x2z_zx_avg(iidx)) + enddo + endif if (ocn_present .and. histavg_xao) then allocate(xao_ox_avg(num_inst_xao)) xao_ox => prep_aoflux_get_xao_ox() @@ -680,6 +721,14 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & x2w_wx_avg(iidx)%rAttr = x2w_wx_avg(iidx)%rAttr + x2c%rAttr enddo endif + if (iac_present .and. histavg_iac) then + do iidx = 1, num_inst_iac + c2x => component_get_c2x_cx(iac(iidx)) + x2c => component_get_x2c_cx(iac(iidx)) + z2x_zx_avg(iidx)%rAttr = z2x_zx_avg(iidx)%rAttr + c2x%rAttr + x2z_zx_avg(iidx)%rAttr = x2z_zx_avg(iidx)%rAttr + x2c%rAttr + enddo + endif if (ocn_present .and. histavg_xao) then xao_ox => prep_aoflux_get_xao_ox() do iidx = 1, num_inst_ocn @@ -753,6 +802,14 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & x2w_wx_avg(iidx)%rAttr = (x2w_wx_avg(iidx)%rAttr + x2c%rAttr) / (cnt * 1.0_r8) enddo endif + if (iac_present .and. histavg_iac) then + do iidx = 1, num_inst_iac + c2x => component_get_c2x_cx(iac(iidx)) + x2c => component_get_x2c_cx(iac(iidx)) + z2x_zx_avg(iidx)%rAttr = (z2x_zx_avg(iidx)%rAttr + c2x%rAttr) / (cnt * 1.0_r8) + x2z_zx_avg(iidx)%rAttr = (x2z_zx_avg(iidx)%rAttr + x2c%rAttr) / (cnt * 1.0_r8) + enddo + endif if (ocn_present .and. histavg_xao) then xao_ox => prep_aoflux_get_xao_ox() do iidx = 1, num_inst_ocn @@ -901,6 +958,18 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & nx=wav_nx, ny=wav_ny, nt=1, whead=whead, wdata=wdata, & pre='x2wavg', tavg=.true.) endif + if (iac_present .and. histavg_iac) then + gsmap => component_get_gsmap_cx(iac(1)) + dom => component_get_dom_cx(iac(1)) + call seq_io_write(hist_file, gsmap, dom%data, 'dom_zx', & + nx=iac_nx, ny=iac_ny, nt=1, whead=whead, wdata=wdata, pre='domw') + call seq_io_write(hist_file, gsmap, z2x_zx_avg, 'z2x_zx', & + nx=iac_nx, ny=iac_ny, nt=1, whead=whead, wdata=wdata, & + pre='z2xavg', tavg=.true.) + call seq_io_write(hist_file, gsmap, x2z_zx_avg, 'x2z_zx', & + nx=iac_nx, ny=iac_ny, nt=1, whead=whead, wdata=wdata, & + pre='x2zavg', tavg=.true.) + endif if (ocn_present .and. histavg_xao) then gsmap => component_get_gsmap_cx(ocn(1)) call seq_io_write(hist_file, gsmap, xao_ox_avg, 'xao_ox', & @@ -960,6 +1029,12 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & call mct_aVect_zero(x2w_wx_avg(iidx)) enddo endif + if (iac_present .and. histavg_iac) then + do iidx = 1, num_inst_wav + call mct_aVect_zero(z2x_zx_avg(iidx)) + call mct_aVect_zero(x2z_zx_avg(iidx)) + enddo + endif if (ocn_present .and. histavg_xao) then do iidx = 1, num_inst_xao call mct_aVect_zero(xao_ox_avg(iidx)) diff --git a/src/drivers/mct/main/seq_rest_mod.F90 b/src/drivers/mct/main/seq_rest_mod.F90 index 258bea527736..f97b4ca51417 100644 --- a/src/drivers/mct/main/seq_rest_mod.F90 +++ b/src/drivers/mct/main/seq_rest_mod.F90 @@ -105,6 +105,7 @@ module seq_rest_mod logical :: glc_present ! .true. => glc is present logical :: wav_present ! .true. => wav is present logical :: esp_present ! .true. => esp is present + logical :: iac_present ! .true. => iac is present logical :: atm_prognostic ! .true. => atm comp expects input logical :: lnd_prognostic ! .true. => lnd comp expects input @@ -114,6 +115,7 @@ module seq_rest_mod logical :: glc_prognostic ! .true. => glc comp expects input logical :: wav_prognostic ! .true. => wav comp expects input logical :: esp_prognostic ! .true. => esp comp expects input + logical :: iac_prognostic ! .true. => iac comp expects input !--- temporary pointers --- type(mct_gsMap), pointer :: gsmap @@ -131,9 +133,9 @@ module seq_rest_mod !=============================================================================== subroutine seq_rest_read(rest_file, infodata, & - atm, lnd, ice, ocn, rof, glc, wav, esp, & + atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx) + fractions_rx, fractions_gx, fractions_wx, fractions_zx) implicit none @@ -147,6 +149,7 @@ subroutine seq_rest_read(rest_file, infodata, & type (component_type) , intent(inout) :: glc(:) type (component_type) , intent(inout) :: wav(:) type (component_type) , intent(inout) :: esp(:) + type (component_type) , intent(inout) :: iac(:) type(mct_aVect) , intent(inout) :: fractions_ax(:) ! Fractions on atm grid/decomp type(mct_aVect) , intent(inout) :: fractions_lx(:) ! Fractions on lnd grid/decomp type(mct_aVect) , intent(inout) :: fractions_ix(:) ! Fractions on ice grid/decomp @@ -154,6 +157,7 @@ subroutine seq_rest_read(rest_file, infodata, & type(mct_aVect) , intent(inout) :: fractions_rx(:) ! Fractions on rof grid/decomp type(mct_aVect) , intent(inout) :: fractions_gx(:) ! Fractions on glc grid/decomp type(mct_aVect) , intent(inout) :: fractions_wx(:) ! Fractions on wav grid/decomp + type(mct_aVect) , intent(inout) :: fractions_zx(:) ! Fractions on iac grid/decomp integer(IN) :: n,n1,n2,n3 real(r8),allocatable :: ds(:) ! for reshaping diag data for restart file @@ -184,6 +188,7 @@ subroutine seq_rest_read(rest_file, infodata, & glc_present=glc_present, & wav_present=wav_present, & esp_present=esp_present, & + iac_present=iac_present, & atm_prognostic=atm_prognostic, & lnd_prognostic=lnd_prognostic, & ice_prognostic=ice_prognostic, & @@ -192,6 +197,7 @@ subroutine seq_rest_read(rest_file, infodata, & ocnrof_prognostic=ocnrof_prognostic, & glc_prognostic=glc_prognostic, & wav_prognostic=wav_prognostic, & + iac_prognostic=iac_prognostic, & esp_prognostic=esp_prognostic) if (iamin_CPLID) then @@ -255,6 +261,11 @@ subroutine seq_rest_read(rest_file, infodata, & call seq_io_read(rest_file, gsmap, fractions_wx, 'fractions_wx') call seq_io_read(rest_file, wav, 'c2x', 'w2x_wx') endif + if (iac_present) then + gsmap => component_get_gsmap_cx(iac(1)) + call seq_io_read(rest_file, gsmap, fractions_zx, 'fractions_zx') + call seq_io_read(rest_file, iac, 'c2x', 'z2x_zx') + endif ! Add ESP restart read here n = size(budg_dataG) @@ -285,9 +296,10 @@ end subroutine seq_rest_read !=============================================================================== subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & - atm, lnd, ice, ocn, rof, glc, wav, esp, & + atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx, tag, rest_file) + fractions_rx, fractions_gx, fractions_wx, fractions_zx, & + tag, rest_file) implicit none @@ -302,6 +314,7 @@ subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & type (component_type) , intent(inout) :: glc(:) type (component_type) , intent(inout) :: wav(:) type (component_type) , intent(inout) :: esp(:) + type (component_type) , intent(inout) :: iac(:) type(mct_aVect) , intent(inout) :: fractions_ax(:) ! Fractions on atm grid/decomp type(mct_aVect) , intent(inout) :: fractions_lx(:) ! Fractions on lnd grid/decomp type(mct_aVect) , intent(inout) :: fractions_ix(:) ! Fractions on ice grid/decomp @@ -309,6 +322,7 @@ subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & type(mct_aVect) , intent(inout) :: fractions_rx(:) ! Fractions on rof grid/decomp type(mct_aVect) , intent(inout) :: fractions_gx(:) ! Fractions on glc grid/decomp type(mct_aVect) , intent(inout) :: fractions_wx(:) ! Fractions on wav grid/decomp + type(mct_aVect) , intent(inout) :: fractions_zx(:) ! Fractions on iac grid/decomp character(len=*) , intent(in) :: tag character(len=CL) , intent(out) :: rest_file ! Restart filename @@ -356,6 +370,7 @@ subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & glc_present=glc_present, & wav_present=wav_present, & esp_present=esp_present, & + iac_present=iac_present, & atm_prognostic=atm_prognostic, & lnd_prognostic=lnd_prognostic, & ice_prognostic=ice_prognostic, & @@ -365,6 +380,7 @@ subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & glc_prognostic=glc_prognostic, & wav_prognostic=wav_prognostic, & esp_prognostic=esp_prognostic, & + iac_prognostic=iac_prognostic, & case_name=case_name, & model_doi_url=model_doi_url) @@ -527,6 +543,13 @@ subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & call seq_io_write(rest_file, wav, 'c2x', 'w2x_wx', & whead=whead, wdata=wdata) endif + if (iac_present) then + gsmap => component_get_gsmap_cx(iac(1)) + call seq_io_write(rest_file, gsmap, fractions_zx, 'fractions_zx', & + whead=whead, wdata=wdata) + call seq_io_write(rest_file, iac, 'c2x', 'z2x_zx', & + whead=whead, wdata=wdata) + endif ! Write ESP restart data here enddo diff --git a/src/drivers/mct/shr/seq_comm_mct.F90 b/src/drivers/mct/shr/seq_comm_mct.F90 index 90efeb4f24bc..4664143e0be8 100644 --- a/src/drivers/mct/shr/seq_comm_mct.F90 +++ b/src/drivers/mct/shr/seq_comm_mct.F90 @@ -66,9 +66,9 @@ module seq_comm_mct integer, public :: global_mype = -1 !! To be initialized -!!! Note - NUM_COMP_INST_XXX are cpp variables set in buildlib.csm_share + !!! Note - NUM_COMP_INST_XXX are cpp variables set in buildlib.csm_share - integer, parameter :: ncomptypes = 8 ! total number of component types + integer, parameter :: ncomptypes = 9 ! total number of component types integer, parameter :: ncouplers = 1 ! number of couplers integer, parameter, public :: num_inst_atm = NUM_COMP_INST_ATM integer, parameter, public :: num_inst_lnd = NUM_COMP_INST_LND @@ -77,6 +77,7 @@ module seq_comm_mct integer, parameter, public :: num_inst_glc = NUM_COMP_INST_GLC integer, parameter, public :: num_inst_wav = NUM_COMP_INST_WAV integer, parameter, public :: num_inst_rof = NUM_COMP_INST_ROF + integer, parameter, public :: num_inst_iac = NUM_COMP_INST_IAC integer, parameter, public :: num_inst_esp = NUM_COMP_INST_ESP integer, parameter, public :: num_inst_total= num_inst_atm + & @@ -86,6 +87,7 @@ module seq_comm_mct num_inst_glc + & num_inst_wav + & num_inst_rof + & + num_inst_iac + & num_inst_esp + 1 integer, public :: num_inst_min, num_inst_max @@ -103,11 +105,13 @@ module seq_comm_mct integer, parameter, public :: num_inst_phys = num_inst_atm + num_inst_lnd + & num_inst_ocn + num_inst_ice + & num_inst_glc + num_inst_rof + & - num_inst_wav + num_inst_esp + num_inst_wav + num_inst_esp + & + num_inst_iac integer, parameter, public :: num_cpl_phys = num_inst_atm + num_inst_lnd + & num_inst_ocn + num_inst_ice + & num_inst_glc + num_inst_rof + & - num_inst_wav + num_inst_esp + num_inst_wav + num_inst_esp + & + num_inst_iac integer, parameter :: ncomps = (1 + ncouplers + 2*ncomptypes + num_inst_phys + num_cpl_phys) integer, public :: GLOID @@ -120,6 +124,7 @@ module seq_comm_mct integer, public :: ALLGLCID integer, public :: ALLROFID integer, public :: ALLWAVID + integer, public :: ALLIACID integer, public :: ALLESPID integer, public :: CPLALLATMID @@ -129,6 +134,7 @@ module seq_comm_mct integer, public :: CPLALLGLCID integer, public :: CPLALLROFID integer, public :: CPLALLWAVID + integer, public :: CPLALLIACID integer, public :: CPLALLESPID integer, public :: ATMID(num_inst_atm) @@ -138,6 +144,7 @@ module seq_comm_mct integer, public :: GLCID(num_inst_glc) integer, public :: ROFID(num_inst_rof) integer, public :: WAVID(num_inst_wav) + integer, public :: IACID(num_inst_iac) integer, public :: ESPID(num_inst_esp) integer, public :: CPLATMID(num_inst_atm) @@ -147,6 +154,7 @@ module seq_comm_mct integer, public :: CPLGLCID(num_inst_glc) integer, public :: CPLROFID(num_inst_rof) integer, public :: CPLWAVID(num_inst_wav) + integer, public :: CPLIACID(num_inst_iac) integer, public :: CPLESPID(num_inst_esp) integer, parameter, public :: seq_comm_namelen=16 @@ -198,7 +206,7 @@ module seq_comm_mct character(len=32), public :: & atm_layout, lnd_layout, ice_layout, glc_layout, rof_layout, & - ocn_layout, wav_layout, esp_layout + ocn_layout, wav_layout, esp_layout, iac_layout logical :: seq_comm_mct_initialized = .false. ! whether this module has been initialized @@ -244,6 +252,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) rof_ntasks, rof_rootpe, rof_pestride, rof_nthreads, & ocn_ntasks, ocn_rootpe, ocn_pestride, ocn_nthreads, & esp_ntasks, esp_rootpe, esp_pestride, esp_nthreads, & + iac_ntasks, iac_rootpe, iac_pestride, iac_nthreads, & cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads, & info_taskmap_model @@ -256,6 +265,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) rof_ntasks, rof_rootpe, rof_pestride, rof_nthreads, rof_layout, & ocn_ntasks, ocn_rootpe, ocn_pestride, ocn_nthreads, ocn_layout, & esp_ntasks, esp_rootpe, esp_pestride, esp_nthreads, esp_layout, & + iac_ntasks, iac_rootpe, iac_pestride, iac_nthreads, iac_layout, & cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads, & info_taskmap_model, info_taskmap_comp !---------------------------------------------------------- @@ -324,6 +334,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) call comp_pelayout_init(numpes, wav_ntasks, wav_rootpe, wav_pestride, wav_nthreads, wav_layout) call comp_pelayout_init(numpes, glc_ntasks, glc_rootpe, glc_pestride, glc_nthreads, glc_layout) call comp_pelayout_init(numpes, esp_ntasks, esp_rootpe, esp_pestride, esp_nthreads, esp_layout) + call comp_pelayout_init(numpes, iac_ntasks, iac_rootpe, iac_pestride, iac_nthreads, iac_layout) call comp_pelayout_init(numpes, cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads) info_taskmap_model = 0 info_taskmap_comp = 0 @@ -351,6 +362,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) call shr_mpi_bcast(wav_nthreads,DRIVER_COMM,'wav_nthreads') call shr_mpi_bcast(rof_nthreads,DRIVER_COMM,'rof_nthreads') call shr_mpi_bcast(esp_nthreads,DRIVER_COMM,'esp_nthreads') + call shr_mpi_bcast(iac_nthreads,DRIVER_COMM,'iac_nthreads') call shr_mpi_bcast(cpl_nthreads,DRIVER_COMM,'cpl_nthreads') call shr_mpi_bcast(atm_layout,DRIVER_COMM,'atm_layout') @@ -360,6 +372,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) call shr_mpi_bcast(glc_layout,DRIVER_COMM,'glc_layout') call shr_mpi_bcast(wav_layout,DRIVER_COMM,'wav_layout') call shr_mpi_bcast(rof_layout,DRIVER_COMM,'rof_layout') + call shr_mpi_bcast(iac_layout,DRIVER_COMM,'iac_layout') call shr_mpi_bcast(esp_layout,DRIVER_COMM,'esp_layout') call shr_mpi_bcast(info_taskmap_model,DRIVER_COMM,'info_taskmap_model') @@ -421,10 +434,10 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) error_state = .false. num_inst_min = min(num_inst_atm, num_inst_lnd, num_inst_ocn,& num_inst_ice, num_inst_glc, num_inst_wav, num_inst_rof,& - num_inst_esp) + num_inst_esp, num_inst_iac) num_inst_max = max(num_inst_atm, num_inst_lnd, num_inst_ocn,& num_inst_ice, num_inst_glc, num_inst_wav, num_inst_rof,& - num_inst_esp) + num_inst_esp, num_inst_iac) if (num_inst_min /= num_inst_max .and. num_inst_min /= 1) error_state = .true. if (num_inst_atm /= num_inst_min .and. num_inst_atm /= num_inst_max) error_state = .true. @@ -434,6 +447,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) if (num_inst_glc /= num_inst_min .and. num_inst_glc /= num_inst_max) error_state = .true. if (num_inst_wav /= num_inst_min .and. num_inst_wav /= num_inst_max) error_state = .true. if (num_inst_rof /= num_inst_min .and. num_inst_rof /= num_inst_max) error_state = .true. + if (num_inst_iac /= num_inst_min .and. num_inst_iac /= num_inst_max) error_state = .true. if (num_inst_esp /= num_inst_min .and. num_inst_esp /= num_inst_max) error_state = .true. if (error_state) then @@ -466,6 +480,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) pelist(2,1) = cpl_rootpe + (cpl_ntasks -1) * cpl_pestride pelist(3,1) = cpl_pestride end if + call mpi_bcast(pelist, size(pelist), MPI_INTEGER, 0, DRIVER_COMM, ierr) call seq_comm_setcomm(CPLID,pelist,nthreads=cpl_nthreads,iname='CPL') @@ -485,6 +500,8 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) CPLID, WAVID, CPLWAVID, ALLWAVID, CPLALLWAVID, 'WAV', count, drv_comm_id) call comp_comm_init(driver_comm, esp_rootpe, esp_nthreads, esp_layout, esp_ntasks, esp_pestride, num_inst_esp, & CPLID, ESPID, CPLESPID, ALLESPID, CPLALLESPID, 'ESP', count, drv_comm_id) + call comp_comm_init(driver_comm, iac_rootpe, iac_nthreads, iac_layout, iac_ntasks, iac_pestride, num_inst_iac, & + CPLID, IACID, CPLIACID, ALLIACID, CPLALLIACID, 'IAC', count, drv_comm_id) if (count /= ncomps) then write(logunit,*) trim(subname),' ERROR in ID count ',count,ncomps diff --git a/src/drivers/mct/shr/seq_flds_mod.F90 b/src/drivers/mct/shr/seq_flds_mod.F90 index 654a926cfb70..3a21de4824f7 100644 --- a/src/drivers/mct/shr/seq_flds_mod.F90 +++ b/src/drivers/mct/shr/seq_flds_mod.F90 @@ -212,6 +212,11 @@ module seq_flds_mod character(CXX) :: seq_flds_r2o_liq_fluxes character(CXX) :: seq_flds_r2o_ice_fluxes + !character(CXX) :: seq_flds_x2z_states + !character(CXX) :: seq_flds_z2x_states + character(CXX) :: seq_flds_z2x_fluxes + character(CXX) :: seq_flds_x2z_fluxes + !---------------------------------------------------------------------------- ! combined state/flux fields !---------------------------------------------------------------------------- diff --git a/src/drivers/mct/shr/seq_infodata_mod.F90 b/src/drivers/mct/shr/seq_infodata_mod.F90 index 1249be4d8dc5..12644e258707 100644 --- a/src/drivers/mct/shr/seq_infodata_mod.F90 +++ b/src/drivers/mct/shr/seq_infodata_mod.F90 @@ -27,7 +27,7 @@ MODULE seq_infodata_mod use seq_comm_mct, only: seq_comm_setptrs, seq_comm_iamroot, seq_comm_iamin use seq_comm_mct, only: num_inst_atm, num_inst_lnd, num_inst_rof use seq_comm_mct, only: num_inst_ocn, num_inst_ice, num_inst_glc - use seq_comm_mct, only: num_inst_wav + use seq_comm_mct, only: num_inst_wav, num_inst_iac use shr_orb_mod, only: SHR_ORB_UNDEF_INT, SHR_ORB_UNDEF_REAL, shr_orb_params implicit none @@ -118,6 +118,7 @@ MODULE seq_infodata_mod character(SHR_KIND_CL) :: rof_gnam ! rof grid character(SHR_KIND_CL) :: glc_gnam ! glc grid character(SHR_KIND_CL) :: wav_gnam ! wav grid + character(SHR_KIND_CL) :: iac_gnam ! iac grid logical :: shr_map_dopole ! pole corrections in shr_map_mod character(SHR_KIND_CL) :: vect_map ! vector mapping option, none, cart3d, cart3d_diag, cart3d_uvw, cart3d_uvw_diag character(SHR_KIND_CS) :: aoflux_grid ! grid for atm ocn flux calc @@ -150,6 +151,7 @@ MODULE seq_infodata_mod logical :: histavg_rof ! cpl writes rof fields in average history file logical :: histavg_glc ! cpl writes glc fields in average history file logical :: histavg_wav ! cpl writes wav fields in average history file + logical :: histavg_iac ! cpl writes iac fields in average history file logical :: histavg_xao ! cpl writes flux xao fields in average history file real(SHR_KIND_R8) :: eps_frac ! fraction error tolerance real(SHR_KIND_R8) :: eps_amask ! atm mask error tolerance @@ -197,6 +199,8 @@ MODULE seq_infodata_mod logical :: wav_prognostic ! does component model need input data from driver logical :: esp_present ! does component model exist logical :: esp_prognostic ! does component model need input data from driver + logical :: iac_present ! does component model exist + logical :: iac_prognostic ! does component model need input data from driver logical :: dead_comps ! do we have dead models integer(SHR_KIND_IN) :: atm_nx ! nx, ny of "2d" grid integer(SHR_KIND_IN) :: atm_ny ! nx, ny of "2d" grid @@ -212,6 +216,8 @@ MODULE seq_infodata_mod integer(SHR_KIND_IN) :: glc_ny ! nx, ny of "2d" grid integer(SHR_KIND_IN) :: wav_nx ! nx, ny of "2d" grid integer(SHR_KIND_IN) :: wav_ny ! nx, ny of "2d" grid + integer(SHR_KIND_IN) :: iac_nx ! nx, ny of "2d" grid + integer(SHR_KIND_IN) :: iac_ny ! nx, ny of "2d" grid !--- set via components and may be time varying --- real(SHR_KIND_R8) :: nextsw_cday ! calendar of next atm shortwave @@ -224,6 +230,7 @@ MODULE seq_infodata_mod integer(SHR_KIND_IN) :: rof_phase ! rof phase integer(SHR_KIND_IN) :: wav_phase ! wav phase integer(SHR_KIND_IN) :: esp_phase ! esp phase + integer(SHR_KIND_IN) :: iac_phase ! iac phase logical :: atm_aero ! atmosphere aerosols logical :: glc_g2lupdate ! update glc2lnd fields in lnd model real(shr_kind_r8) :: max_cplstep_time ! abort if cplstep time exceeds this value @@ -356,6 +363,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) character(SHR_KIND_CL) :: rof_gnam ! rof grid character(SHR_KIND_CL) :: glc_gnam ! glc grid character(SHR_KIND_CL) :: wav_gnam ! wav grid + character(SHR_KIND_CL) :: iac_gnam ! iac grid logical :: shr_map_dopole ! pole corrections in shr_map_mod character(SHR_KIND_CL) :: vect_map ! vector mapping option character(SHR_KIND_CS) :: aoflux_grid ! grid for atm ocn flux calc @@ -387,6 +395,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) logical :: histavg_rof ! cpl writes rof fields in average history file logical :: histavg_glc ! cpl writes glc fields in average history file logical :: histavg_wav ! cpl writes wav fields in average history file + logical :: histavg_iac ! cpl writes wav fields in average history file logical :: histavg_xao ! cpl writes flux xao fields in average history file logical :: drv_threading ! is threading control in driver turned on real(SHR_KIND_R8) :: eps_frac ! fraction error tolerance @@ -423,7 +432,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) wv_sat_use_tables, wv_sat_table_spacing, & tfreeze_option, glc_renormalize_smb, & ice_gnam, rof_gnam, glc_gnam, wav_gnam, & - atm_gnam, lnd_gnam, ocn_gnam, cpl_decomp, & + atm_gnam, lnd_gnam, ocn_gnam, iac_gnam, cpl_decomp, & shr_map_dopole, vect_map, aoflux_grid, do_histinit, & do_budgets, drv_threading, & budget_inst, budget_daily, budget_month, & @@ -434,6 +443,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) histaux_double_precision, & histavg_atm, histavg_lnd, histavg_ocn, histavg_ice, & histavg_rof, histavg_glc, histavg_wav, histavg_xao, & + histavg_iac, & histaux_l2x1yrg, cpl_seq_option, & eps_frac, eps_amask, & eps_agrid, eps_aarea, eps_omask, eps_ogrid, & @@ -506,6 +516,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) rof_gnam = 'undefined' glc_gnam = 'undefined' wav_gnam = 'undefined' + iac_gnam = 'undefined' shr_map_dopole = .true. vect_map = 'cart3d' aoflux_grid = 'ocn' @@ -536,6 +547,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) histavg_rof = .true. histavg_glc = .true. histavg_wav = .true. + histavg_iac = .true. histavg_xao = .true. drv_threading = .false. eps_frac = 1.0e-02_SHR_KIND_R8 @@ -631,6 +643,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%rof_gnam = rof_gnam infodata%glc_gnam = glc_gnam infodata%wav_gnam = wav_gnam + infodata%iac_gnam = iac_gnam infodata%shr_map_dopole = shr_map_dopole #ifdef COMPARE_TO_NUOPC infodata%vect_map = 'none' @@ -665,6 +678,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%histavg_rof = histavg_rof infodata%histavg_glc = histavg_glc infodata%histavg_wav = histavg_wav + infodata%histavg_iac = histavg_iac infodata%histavg_xao = histavg_xao infodata%drv_threading = drv_threading infodata%eps_frac = eps_frac @@ -698,6 +712,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%glcocn_present = .true. infodata%glcice_present = .true. infodata%esp_present = .true. + infodata%iac_present = .true. infodata%atm_prognostic = .false. infodata%lnd_prognostic = .false. @@ -712,6 +727,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) ! in all cases. infodata%glc_coupled_fluxes = .true. infodata%wav_prognostic = .false. + infodata%iac_prognostic = .false. infodata%iceberg_prognostic = .false. infodata%esp_prognostic = .false. infodata%dead_comps = .false. @@ -730,6 +746,8 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%glc_ny = 0 infodata%wav_nx = 0 infodata%wav_ny = 0 + infodata%iac_nx = 0 + infodata%iac_ny = 0 infodata%nextsw_cday = -1.0_SHR_KIND_R8 infodata%precip_fact = 1.0_SHR_KIND_R8 @@ -740,6 +758,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%glc_phase = 1 infodata%rof_phase = 1 infodata%wav_phase = 1 + infodata%iac_phase = 1 infodata%atm_aero = .false. infodata%glc_g2lupdate = .false. infodata%glc_valid_input = .true. @@ -859,6 +878,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%ocn_present = .true. infodata%glc_present = .false. infodata%wav_present = .false. + infodata%iac_present = .false. infodata%glclnd_present = .false. infodata%glcocn_present = .false. infodata%glcice_present = .false. @@ -929,12 +949,13 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ atm_present, atm_prognostic, lnd_present, lnd_prognostic, rof_prognostic, & rof_present, ocn_present, ocn_prognostic, ocnrof_prognostic, & ice_present, ice_prognostic, glc_present, glc_prognostic, & + iac_present, iac_prognostic, & glc_coupled_fluxes, & flood_present, wav_present, wav_prognostic, rofice_present, & glclnd_present, glcocn_present, glcice_present, iceberg_prognostic,& esp_present, esp_prognostic, & bfbflag, lnd_gnam, cpl_decomp, cpl_seq_option, & - ice_gnam, rof_gnam, glc_gnam, wav_gnam, & + ice_gnam, rof_gnam, glc_gnam, wav_gnam, iac_gnam, & atm_gnam, ocn_gnam, info_debug, dead_comps, read_restart, & shr_map_dopole, vect_map, aoflux_grid, flux_epbalfact, & nextsw_cday, precip_fact, flux_epbal, flux_albav, & @@ -948,15 +969,15 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ histaux_a2x3hr, histaux_a2x3hrp , histaux_l2x1yrg, & histaux_a2x24hr, histaux_l2x , histaux_r2x , histaux_double_precision, & orb_obliq, histavg_atm, histavg_lnd, histavg_ocn, histavg_ice, & - histavg_rof, histavg_glc, histavg_wav, histavg_xao, & + histavg_rof, histavg_glc, histavg_wav, histavg_xao, histavg_iac, & orb_iyear, orb_iyear_align, orb_mode, orb_mvelp, & orb_eccen, orb_obliqr, orb_lambm0, orb_mvelpp, wv_sat_scheme, & wv_sat_transition_start, wv_sat_use_tables, wv_sat_table_spacing, & tfreeze_option, glc_renormalize_smb, & glc_phase, rof_phase, atm_phase, lnd_phase, ocn_phase, ice_phase, & - wav_phase, esp_phase, wav_nx, wav_ny, atm_nx, atm_ny, & + wav_phase, iac_phase, esp_phase, wav_nx, wav_ny, atm_nx, atm_ny, & lnd_nx, lnd_ny, rof_nx, rof_ny, ice_nx, ice_ny, ocn_nx, ocn_ny, & - glc_nx, glc_ny, eps_frac, eps_amask, & + iac_nx, iac_ny, glc_nx, glc_ny, eps_frac, eps_amask, & eps_agrid, eps_aarea, eps_omask, eps_ogrid, eps_oarea, & reprosum_use_ddpdd, reprosum_allow_infnan, & reprosum_diffmax, reprosum_recompute, & @@ -1024,6 +1045,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ character(len=*), optional, intent(OUT) :: rof_gnam ! rof grid character(len=*), optional, intent(OUT) :: glc_gnam ! glc grid character(len=*), optional, intent(OUT) :: wav_gnam ! wav grid + character(len=*), optional, intent(OUT) :: iac_gnam ! iac grid logical, optional, intent(OUT) :: shr_map_dopole ! pole corrections in shr_map_mod character(len=*), optional, intent(OUT) :: vect_map ! vector mapping option character(len=*), optional, intent(OUT) :: aoflux_grid ! grid for atm ocn flux calc @@ -1054,6 +1076,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(OUT) :: histavg_rof logical, optional, intent(OUT) :: histavg_glc logical, optional, intent(OUT) :: histavg_wav + logical, optional, intent(OUT) :: histavg_iac logical, optional, intent(OUT) :: histavg_xao logical, optional, intent(OUT) :: drv_threading ! driver threading control flag real(SHR_KIND_R8), optional, intent(OUT) :: eps_frac ! fraction error tolerance @@ -1097,6 +1120,8 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(OUT) :: glc_coupled_fluxes logical, optional, intent(OUT) :: wav_present logical, optional, intent(OUT) :: wav_prognostic + logical, optional, intent(OUT) :: iac_present + logical, optional, intent(OUT) :: iac_prognostic logical, optional, intent(OUT) :: esp_present logical, optional, intent(OUT) :: esp_prognostic integer(SHR_KIND_IN), optional, intent(OUT) :: atm_nx ! nx,ny 2d grid size global @@ -1113,6 +1138,8 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ integer(SHR_KIND_IN), optional, intent(OUT) :: glc_ny integer(SHR_KIND_IN), optional, intent(OUT) :: wav_nx integer(SHR_KIND_IN), optional, intent(OUT) :: wav_ny + integer(SHR_KIND_IN), optional, intent(OUT) :: iac_nx + integer(SHR_KIND_IN), optional, intent(OUT) :: iac_ny real(SHR_KIND_R8), optional, intent(OUT) :: nextsw_cday ! calendar of next atm shortwave real(SHR_KIND_R8), optional, intent(OUT) :: precip_fact ! precip factor @@ -1124,6 +1151,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ integer(SHR_KIND_IN), optional, intent(OUT) :: glc_phase ! glc phase integer(SHR_KIND_IN), optional, intent(OUT) :: rof_phase ! rof phase integer(SHR_KIND_IN), optional, intent(OUT) :: wav_phase ! wav phase + integer(SHR_KIND_IN), optional, intent(OUT) :: iac_phase ! wav phase integer(SHR_KIND_IN), optional, intent(OUT) :: esp_phase ! wav phase logical, optional, intent(OUT) :: atm_aero ! atmosphere aerosols logical, optional, intent(OUT) :: glc_g2lupdate ! update glc2lnd fields in lnd model @@ -1192,6 +1220,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(rof_gnam) ) rof_gnam = infodata%rof_gnam if ( present(glc_gnam) ) glc_gnam = infodata%glc_gnam if ( present(wav_gnam) ) wav_gnam = infodata%wav_gnam + if ( present(iac_gnam) ) iac_gnam = infodata%iac_gnam if ( present(shr_map_dopole) ) shr_map_dopole = infodata%shr_map_dopole if ( present(vect_map) ) vect_map = infodata%vect_map if ( present(aoflux_grid) ) aoflux_grid = infodata%aoflux_grid @@ -1222,6 +1251,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(histavg_rof) ) histavg_rof = infodata%histavg_rof if ( present(histavg_glc) ) histavg_glc = infodata%histavg_glc if ( present(histavg_wav) ) histavg_wav = infodata%histavg_wav + if ( present(histavg_iac) ) histavg_iac = infodata%histavg_iac if ( present(histavg_xao) ) histavg_xao = infodata%histavg_xao if ( present(drv_threading) ) drv_threading = infodata%drv_threading if ( present(eps_frac) ) eps_frac = infodata%eps_frac @@ -1267,6 +1297,8 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(wav_prognostic) ) wav_prognostic = infodata%wav_prognostic if ( present(esp_present) ) esp_present = infodata%esp_present if ( present(esp_prognostic) ) esp_prognostic = infodata%esp_prognostic + if ( present(iac_present) ) iac_present = infodata%iac_present + if ( present(iac_prognostic) ) iac_prognostic = infodata%iac_prognostic if ( present(atm_nx) ) atm_nx = infodata%atm_nx if ( present(atm_ny) ) atm_ny = infodata%atm_ny if ( present(lnd_nx) ) lnd_nx = infodata%lnd_nx @@ -1281,6 +1313,8 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(glc_ny) ) glc_ny = infodata%glc_ny if ( present(wav_nx) ) wav_nx = infodata%wav_nx if ( present(wav_ny) ) wav_ny = infodata%wav_ny + if ( present(iac_nx) ) iac_nx = infodata%iac_nx + if ( present(iac_ny) ) iac_ny = infodata%iac_ny if ( present(nextsw_cday) ) nextsw_cday = infodata%nextsw_cday if ( present(precip_fact) ) precip_fact = infodata%precip_fact @@ -1305,6 +1339,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(rof_phase) ) rof_phase = infodata%rof_phase if ( present(wav_phase) ) wav_phase = infodata%wav_phase if ( present(esp_phase) ) esp_phase = infodata%esp_phase + if ( present(iac_phase) ) iac_phase = infodata%iac_phase if ( present(atm_aero) ) atm_aero = infodata%atm_aero if ( present(glc_g2lupdate) ) glc_g2lupdate = infodata%glc_g2lupdate if ( present(max_cplstep_time) ) max_cplstep_time = infodata%max_cplstep_time @@ -1383,6 +1418,11 @@ SUBROUTINE seq_infodata_GetData_bytype( component_firstletter, infodata, & wav_prognostic=comp_prognostic, wav_gnam=comp_gnam, & wav_phase=comp_phase, wav_nx=comp_nx, wav_ny=comp_ny, & histavg_wav=histavg_comp) + else if (component_firstletter == 'z') then + call seq_infodata_GetData(infodata, iac_present=comp_present, & + iac_prognostic=comp_prognostic, iac_gnam=comp_gnam, & + iac_phase=comp_phase, iac_nx=comp_nx, iac_ny=comp_ny, & + histavg_iac=histavg_comp) else if (component_firstletter == 'e') then if (present(comp_gnam)) then comp_gnam = '' @@ -1439,8 +1479,9 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ flood_present, wav_present, wav_prognostic, rofice_present, & glclnd_present, glcocn_present, glcice_present, iceberg_prognostic,& esp_present, esp_prognostic, & + iac_present, iac_prognostic, & bfbflag, lnd_gnam, cpl_decomp, cpl_seq_option, & - ice_gnam, rof_gnam, glc_gnam, wav_gnam, & + ice_gnam, rof_gnam, glc_gnam, wav_gnam, iac_gnam, & atm_gnam, ocn_gnam, info_debug, dead_comps, read_restart, & shr_map_dopole, vect_map, aoflux_grid, run_barriers, & nextsw_cday, precip_fact, flux_epbal, flux_albav, & @@ -1454,15 +1495,15 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ histaux_a2x3hr, histaux_a2x3hrp , histaux_l2x1yrg, & histaux_a2x24hr, histaux_l2x , histaux_r2x , histaux_double_precision, & orb_obliq, histavg_atm, histavg_lnd, histavg_ocn, histavg_ice, & - histavg_rof, histavg_glc, histavg_wav, histavg_xao, & + histavg_rof, histavg_glc, histavg_wav, histavg_xao, histavg_iac, & orb_iyear, orb_iyear_align, orb_mode, orb_mvelp, & orb_eccen, orb_obliqr, orb_lambm0, orb_mvelpp, wv_sat_scheme, & wv_sat_transition_start, wv_sat_use_tables, wv_sat_table_spacing, & tfreeze_option, glc_renormalize_smb, & glc_phase, rof_phase, atm_phase, lnd_phase, ocn_phase, ice_phase, & - wav_phase, esp_phase, wav_nx, wav_ny, atm_nx, atm_ny, & + wav_phase, iac_phase, esp_phase, wav_nx, wav_ny, atm_nx, atm_ny, & lnd_nx, lnd_ny, rof_nx, rof_ny, ice_nx, ice_ny, ocn_nx, ocn_ny, & - glc_nx, glc_ny, eps_frac, eps_amask, & + iac_nx, iac_ny, glc_nx, glc_ny, eps_frac, eps_amask, & eps_agrid, eps_aarea, eps_omask, eps_ogrid, eps_oarea, & reprosum_use_ddpdd, reprosum_allow_infnan, & reprosum_diffmax, reprosum_recompute, & @@ -1528,6 +1569,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ character(len=*), optional, intent(IN) :: rof_gnam ! rof grid character(len=*), optional, intent(IN) :: glc_gnam ! glc grid character(len=*), optional, intent(IN) :: wav_gnam ! wav grid + character(len=*), optional, intent(IN) :: iac_gnam ! iac grid logical, optional, intent(IN) :: shr_map_dopole ! pole corrections in shr_map_mod character(len=*), optional, intent(IN) :: vect_map ! vector mapping option character(len=*), optional, intent(IN) :: aoflux_grid ! grid for atm ocn flux calc @@ -1559,6 +1601,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(IN) :: histavg_glc logical, optional, intent(IN) :: histavg_wav logical, optional, intent(IN) :: histavg_xao + logical, optional, intent(IN) :: histavg_iac logical, optional, intent(IN) :: drv_threading ! driver threading control flag real(SHR_KIND_R8), optional, intent(IN) :: eps_frac ! fraction error tolerance real(SHR_KIND_R8), optional, intent(IN) :: eps_amask ! atm mask error tolerance @@ -1603,6 +1646,8 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(IN) :: wav_prognostic logical, optional, intent(IN) :: esp_present logical, optional, intent(IN) :: esp_prognostic + logical, optional, intent(IN) :: iac_present + logical, optional, intent(IN) :: iac_prognostic integer(SHR_KIND_IN), optional, intent(IN) :: atm_nx ! nx,ny 2d grid size global integer(SHR_KIND_IN), optional, intent(IN) :: atm_ny ! nx,ny 2d grid size global integer(SHR_KIND_IN), optional, intent(IN) :: lnd_nx @@ -1617,6 +1662,8 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ integer(SHR_KIND_IN), optional, intent(IN) :: glc_ny integer(SHR_KIND_IN), optional, intent(IN) :: wav_nx integer(SHR_KIND_IN), optional, intent(IN) :: wav_ny + integer(SHR_KIND_IN), optional, intent(IN) :: iac_nx + integer(SHR_KIND_IN), optional, intent(IN) :: iac_ny real(SHR_KIND_R8), optional, intent(IN) :: nextsw_cday ! calendar of next atm shortwave real(SHR_KIND_R8), optional, intent(IN) :: precip_fact ! precip factor @@ -1627,6 +1674,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ integer(SHR_KIND_IN), optional, intent(IN) :: glc_phase ! glc phase integer(SHR_KIND_IN), optional, intent(IN) :: rof_phase ! rof phase integer(SHR_KIND_IN), optional, intent(IN) :: wav_phase ! wav phase + integer(SHR_KIND_IN), optional, intent(IN) :: iac_phase ! iac phase integer(SHR_KIND_IN), optional, intent(IN) :: esp_phase ! esp phase logical, optional, intent(IN) :: atm_aero ! atm aerosols logical, optional, intent(IN) :: glc_g2lupdate ! update glc2lnd fields in lnd model @@ -1694,6 +1742,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(rof_gnam) ) infodata%rof_gnam = rof_gnam if ( present(glc_gnam) ) infodata%glc_gnam = glc_gnam if ( present(wav_gnam) ) infodata%wav_gnam = wav_gnam + if ( present(iac_gnam) ) infodata%iac_gnam = iac_gnam if ( present(shr_map_dopole) ) infodata%shr_map_dopole = shr_map_dopole if ( present(vect_map) ) infodata%vect_map = vect_map if ( present(aoflux_grid) ) infodata%aoflux_grid = aoflux_grid @@ -1724,6 +1773,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(histavg_rof) ) infodata%histavg_rof = histavg_rof if ( present(histavg_glc) ) infodata%histavg_glc = histavg_glc if ( present(histavg_wav) ) infodata%histavg_wav = histavg_wav + if ( present(histavg_iac) ) infodata%histavg_iac = histavg_iac if ( present(histavg_xao) ) infodata%histavg_xao = histavg_xao if ( present(drv_threading) ) infodata%drv_threading = drv_threading if ( present(eps_frac) ) infodata%eps_frac = eps_frac @@ -1767,6 +1817,8 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(glc_coupled_fluxes)) infodata%glc_coupled_fluxes = glc_coupled_fluxes if ( present(wav_present) ) infodata%wav_present = wav_present if ( present(wav_prognostic) ) infodata%wav_prognostic = wav_prognostic + if ( present(iac_present) ) infodata%iac_present = iac_present + if ( present(iac_prognostic) ) infodata%iac_prognostic = iac_prognostic if ( present(esp_present) ) infodata%esp_present = esp_present if ( present(esp_prognostic) ) infodata%esp_prognostic = esp_prognostic if ( present(atm_nx) ) infodata%atm_nx = atm_nx @@ -1783,6 +1835,8 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(glc_ny) ) infodata%glc_ny = glc_ny if ( present(wav_nx) ) infodata%wav_nx = wav_nx if ( present(wav_ny) ) infodata%wav_ny = wav_ny + if ( present(iac_nx) ) infodata%iac_nx = iac_nx + if ( present(iac_ny) ) infodata%iac_ny = iac_ny if ( present(nextsw_cday) ) infodata%nextsw_cday = nextsw_cday if ( present(precip_fact) ) infodata%precip_fact = precip_fact @@ -1793,6 +1847,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(glc_phase) ) infodata%glc_phase = glc_phase if ( present(rof_phase) ) infodata%rof_phase = rof_phase if ( present(wav_phase) ) infodata%wav_phase = wav_phase + if ( present(iac_phase) ) infodata%iac_phase = iac_phase if ( present(esp_phase) ) infodata%esp_phase = esp_phase if ( present(atm_aero) ) infodata%atm_aero = atm_aero if ( present(glc_g2lupdate) ) infodata%glc_g2lupdate = glc_g2lupdate @@ -1870,6 +1925,11 @@ SUBROUTINE seq_infodata_PutData_bytype( component_firstletter, infodata, & wav_prognostic=comp_prognostic, wav_gnam=comp_gnam, & wav_phase=comp_phase, wav_nx=comp_nx, wav_ny=comp_ny, & histavg_wav=histavg_comp) + else if (component_firstletter == 'z') then + call seq_infodata_PutData(infodata, iac_present=comp_present, & + iac_prognostic=comp_prognostic, iac_gnam=comp_gnam, & + iac_phase=comp_phase, iac_nx=comp_nx, iac_ny=comp_ny, & + histavg_iac=histavg_comp) else if (component_firstletter == 'e') then if ((loglevel > 1) .and. seq_comm_iamroot(1)) then if (present(comp_gnam)) then @@ -1980,6 +2040,7 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%rof_gnam, mpicom) call shr_mpi_bcast(infodata%glc_gnam, mpicom) call shr_mpi_bcast(infodata%wav_gnam, mpicom) + call shr_mpi_bcast(infodata%iac_gnam, mpicom) call shr_mpi_bcast(infodata%shr_map_dopole, mpicom) call shr_mpi_bcast(infodata%vect_map, mpicom) call shr_mpi_bcast(infodata%aoflux_grid, mpicom) @@ -2010,6 +2071,7 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%histavg_rof , mpicom) call shr_mpi_bcast(infodata%histavg_glc , mpicom) call shr_mpi_bcast(infodata%histavg_wav , mpicom) + call shr_mpi_bcast(infodata%histavg_iac , mpicom) call shr_mpi_bcast(infodata%histavg_xao , mpicom) call shr_mpi_bcast(infodata%drv_threading, mpicom) call shr_mpi_bcast(infodata%eps_frac, mpicom) @@ -2055,6 +2117,8 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%wav_prognostic, mpicom) call shr_mpi_bcast(infodata%esp_present, mpicom) call shr_mpi_bcast(infodata%esp_prognostic, mpicom) + call shr_mpi_bcast(infodata%iac_present, mpicom) + call shr_mpi_bcast(infodata%iac_prognostic, mpicom) call shr_mpi_bcast(infodata%atm_nx, mpicom) call shr_mpi_bcast(infodata%atm_ny, mpicom) @@ -2070,6 +2134,8 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%glc_ny, mpicom) call shr_mpi_bcast(infodata%wav_nx, mpicom) call shr_mpi_bcast(infodata%wav_ny, mpicom) + call shr_mpi_bcast(infodata%iac_nx, mpicom) + call shr_mpi_bcast(infodata%iac_ny, mpicom) call shr_mpi_bcast(infodata%nextsw_cday, mpicom) call shr_mpi_bcast(infodata%precip_fact, mpicom) @@ -2080,6 +2146,7 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%glc_phase, mpicom) call shr_mpi_bcast(infodata%rof_phase, mpicom) call shr_mpi_bcast(infodata%wav_phase, mpicom) + call shr_mpi_bcast(infodata%iac_phase, mpicom) call shr_mpi_bcast(infodata%atm_aero, mpicom) call shr_mpi_bcast(infodata%glc_g2lupdate, mpicom) call shr_mpi_bcast(infodata%glc_valid_input, mpicom) @@ -2123,6 +2190,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) logical :: ice2cpli,ice2cplr logical :: glc2cpli,glc2cplr logical :: wav2cpli,wav2cplr + logical :: iac2cpli,iac2cplr logical :: esp2cpli logical :: cpl2i,cpl2r logical :: logset @@ -2151,6 +2219,8 @@ subroutine seq_infodata_Exchange(infodata,ID,type) glc2cplr = .false. wav2cpli = .false. wav2cplr = .false. + iac2cpli = .false. + iac2cplr = .false. esp2cpli = .false. cpl2i = .false. cpl2r = .false. @@ -2227,6 +2297,16 @@ subroutine seq_infodata_Exchange(infodata,ID,type) logset = .true. endif + if (trim(type) == 'iac2cpl_init') then + iac2cpli = .true. + iac2cplr = .true. + logset = .true. + endif + if (trim(type) == 'iac2cpl_run') then + iac2cplr = .true. + logset = .true. + endif + if (trim(type) == 'esp2cpl_init') then esp2cpli = .true. logset = .true. @@ -2238,6 +2318,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) trim(type) == 'cpl2ocn_init' .or. & trim(type) == 'cpl2glc_init' .or. & trim(type) == 'cpl2wav_init' .or. & + trim(type) == 'cpl2iac_init' .or. & trim(type) == 'cpl2esp_init' .or. & trim(type) == 'cpl2ice_init') then cpl2i = .true. @@ -2251,6 +2332,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) trim(type) == 'cpl2ocn_run' .or. & trim(type) == 'cpl2glc_run' .or. & trim(type) == 'cpl2wav_run' .or. & + trim(type) == 'cpl2iac_run' .or. & trim(type) == 'cpl2ice_run') then cpl2r = .true. logset = .true. @@ -2351,6 +2433,17 @@ subroutine seq_infodata_Exchange(infodata,ID,type) if (deads .or. infodata%dead_comps) infodata%dead_comps = .true. endif + if (iac2cpli) then + call shr_mpi_bcast(infodata%iac_present, mpicom, pebcast=cmppe) + call shr_mpi_bcast(infodata%iac_prognostic, mpicom, pebcast=cmppe) + call shr_mpi_bcast(infodata%iac_nx, mpicom, pebcast=cmppe) + call shr_mpi_bcast(infodata%iac_ny, mpicom, pebcast=cmppe) + ! dead_comps is true if it's ever set to true + deads = infodata%dead_comps + call shr_mpi_bcast(deads, mpicom, pebcast=cmppe) + if (deads .or. infodata%dead_comps) infodata%dead_comps = .true. + endif + if (esp2cpli) then call shr_mpi_bcast(infodata%esp_present, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%esp_prognostic, mpicom, pebcast=cmppe) @@ -2379,6 +2472,8 @@ subroutine seq_infodata_Exchange(infodata,ID,type) call shr_mpi_bcast(infodata%glc_coupled_fluxes, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%wav_present, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%wav_prognostic, mpicom, pebcast=cplpe) + call shr_mpi_bcast(infodata%iac_present, mpicom, pebcast=cplpe) + call shr_mpi_bcast(infodata%iac_prognostic, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%esp_present, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%esp_prognostic, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%dead_comps, mpicom, pebcast=cplpe) @@ -2638,6 +2733,7 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0A) subname,'rof_gridname = ', trim(infodata%rof_gnam) write(logunit,F0A) subname,'glc_gridname = ', trim(infodata%glc_gnam) write(logunit,F0A) subname,'wav_gridname = ', trim(infodata%wav_gnam) + write(logunit,F0A) subname,'iac_gridname = ', trim(infodata%iac_gnam) write(logunit,F0L) subname,'shr_map_dopole = ', infodata%shr_map_dopole write(logunit,F0A) subname,'vect_map = ', trim(infodata%vect_map) write(logunit,F0A) subname,'aoflux_grid = ', trim(infodata%aoflux_grid) @@ -2668,6 +2764,7 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0L) subname,'histavg_rof = ', infodata%histavg_rof write(logunit,F0L) subname,'histavg_glc = ', infodata%histavg_glc write(logunit,F0L) subname,'histavg_wav = ', infodata%histavg_wav + write(logunit,F0L) subname,'histavg_iac = ', infodata%histavg_iac write(logunit,F0L) subname,'histavg_xao = ', infodata%histavg_xao write(logunit,F0L) subname,'drv_threading = ', infodata%drv_threading @@ -2715,6 +2812,8 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0L) subname,'glc_coupled_fluxes = ', infodata%glc_coupled_fluxes write(logunit,F0L) subname,'wav_present = ', infodata%wav_present write(logunit,F0L) subname,'wav_prognostic = ', infodata%wav_prognostic + write(logunit,F0L) subname,'iac_present = ', infodata%iac_present + write(logunit,F0L) subname,'iac_prognostic = ', infodata%iac_prognostic write(logunit,F0L) subname,'esp_present = ', infodata%esp_present write(logunit,F0L) subname,'esp_prognostic = ', infodata%esp_prognostic @@ -2732,6 +2831,8 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0I) subname,'glc_ny = ', infodata%glc_ny write(logunit,F0I) subname,'wav_nx = ', infodata%wav_nx write(logunit,F0I) subname,'wav_ny = ', infodata%wav_ny + write(logunit,F0I) subname,'iac_nx = ', infodata%iac_nx + write(logunit,F0I) subname,'iac_ny = ', infodata%iac_ny write(logunit,F0R) subname,'nextsw_cday = ', infodata%nextsw_cday write(logunit,F0R) subname,'precip_fact = ', infodata%precip_fact @@ -2744,6 +2845,7 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0S) subname,'glc_phase = ', infodata%glc_phase write(logunit,F0S) subname,'rof_phase = ', infodata%rof_phase write(logunit,F0S) subname,'wav_phase = ', infodata%wav_phase + write(logunit,F0S) subname,'iac_phase = ', infodata%iac_phase write(logunit,F0L) subname,'glc_g2lupdate = ', infodata%glc_g2lupdate ! endif diff --git a/src/drivers/mct/shr/seq_timemgr_mod.F90 b/src/drivers/mct/shr/seq_timemgr_mod.F90 index 18ae5579c5a1..e945f28367d7 100644 --- a/src/drivers/mct/shr/seq_timemgr_mod.F90 +++ b/src/drivers/mct/shr/seq_timemgr_mod.F90 @@ -153,9 +153,10 @@ module seq_timemgr_mod seq_timemgr_nclock_glc = 6, & seq_timemgr_nclock_wav = 7, & seq_timemgr_nclock_rof = 8, & - seq_timemgr_nclock_esp = 9 + seq_timemgr_nclock_iac = 9, & + seq_timemgr_nclock_esp = 10 - integer(SHR_KIND_IN),private,parameter :: max_clocks = 9 + integer(SHR_KIND_IN),private,parameter :: max_clocks = 10 character(len=*),public,parameter :: & seq_timemgr_clock_drv = 'seq_timemgr_clock_drv' , & seq_timemgr_clock_atm = 'seq_timemgr_clock_atm' , & @@ -168,7 +169,8 @@ module seq_timemgr_mod seq_timemgr_clock_esp = 'seq_timemgr_clock_esp' character(len=8),private,parameter :: seq_timemgr_clocks(max_clocks) = & (/'drv ','atm ','lnd ','ocn ', & - 'ice ','glc ','wav ','rof ','esp '/) + 'ice ','glc ','wav ','rof ', & + 'iac ','esp '/) ! Alarms on both component clocks and driver clock integer(SHR_KIND_IN),private,parameter :: & @@ -188,9 +190,10 @@ module seq_timemgr_mod seq_timemgr_nalarm_histavg =14 , & ! driver and component clock alarm seq_timemgr_nalarm_rofrun =15 , & ! driver only clock alarm seq_timemgr_nalarm_wavrun =16 , & ! driver only clock alarm - seq_timemgr_nalarm_esprun =17 , & ! driver only clock alarm - seq_timemgr_nalarm_pause =18 , & - seq_timemgr_nalarm_barrier =19 , & ! driver and component clock alarm + seq_timemgr_nalarm_iacrun =17 , & ! driver only clock alarm + seq_timemgr_nalarm_esprun =18 , & ! driver only clock alarm + seq_timemgr_nalarm_pause =19 , & + seq_timemgr_nalarm_barrier =20 , & ! driver and component clock alarm max_alarms = seq_timemgr_nalarm_barrier character(len=*),public,parameter :: & @@ -210,6 +213,7 @@ module seq_timemgr_mod seq_timemgr_alarm_histavg = 'seq_timemgr_alarm_histavg ', & seq_timemgr_alarm_rofrun = 'seq_timemgr_alarm_rofrun ', & seq_timemgr_alarm_wavrun = 'seq_timemgr_alarm_wavrun ', & + seq_timemgr_alarm_iacrun = 'seq_timemgr_alarm_iacrun ', & seq_timemgr_alarm_esprun = 'seq_timemgr_alarm_esprun ', & seq_timemgr_alarm_pause = 'seq_timemgr_alarm_pause ', & seq_timemgr_alarm_barrier = 'seq_timemgr_alarm_barrier ' @@ -255,7 +259,7 @@ module seq_timemgr_mod subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioid, mpicom, & EClock_drv, EClock_atm, EClock_lnd, EClock_ocn, EClock_ice, Eclock_glc, & - Eclock_rof, EClock_wav, Eclock_esp) + Eclock_rof, EClock_wav, Eclock_esp, Eclock_iac) ! !USES: use pio, only : file_desc_T @@ -280,6 +284,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi type(ESMF_clock),target, intent(IN) :: EClock_glc ! glc clock type(ESMF_clock),target, intent(IN) :: EClock_rof ! rof clock type(ESMF_clock),target, intent(IN) :: EClock_wav ! wav clock + type(ESMF_clock),target, intent(IN) :: EClock_iac ! iac clock type(ESMF_clock),target, intent(IN) :: EClock_esp ! esp clock type(file_desc_t) :: pioid @@ -324,6 +329,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi logical :: pause_active_ice logical :: pause_active_rof logical :: pause_active_lnd + logical :: pause_active_iac logical :: data_assimilation_atm logical :: data_assimilation_cpl @@ -333,6 +339,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi logical :: data_assimilation_ice logical :: data_assimilation_rof logical :: data_assimilation_lnd + logical :: data_assimilation_iac character(SHR_KIND_CS) :: history_option ! History option units integer(SHR_KIND_IN) :: history_n ! Number until history interval @@ -360,6 +367,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi character(SHR_KIND_CS) :: glc_avg_period ! Glc avering coupling period integer(SHR_KIND_IN) :: rof_cpl_dt ! Runoff coupling interval integer(SHR_KIND_IN) :: wav_cpl_dt ! Wav coupling interval + integer(SHR_KIND_IN) :: iac_cpl_dt ! Iac coupling interval integer(SHR_KIND_IN) :: esp_cpl_dt ! Esp coupling interval integer(SHR_KIND_IN) :: atm_cpl_offset ! Atmosphere coupling interval integer(SHR_KIND_IN) :: lnd_cpl_offset ! Land coupling interval @@ -369,6 +377,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi integer(SHR_KIND_IN) :: wav_cpl_offset ! Wav coupling interval integer(SHR_KIND_IN) :: rof_cpl_offset ! Runoff coupling interval integer(SHR_KIND_IN) :: esp_cpl_offset ! Esp coupling interval + integer(SHR_KIND_IN) :: iac_cpl_offset ! Iac coupling interval logical :: esp_run_on_pause ! Run ESP on pause cycle logical :: end_restart ! Write restart at end of run integer(SHR_KIND_IN) :: ierr ! Return code @@ -386,6 +395,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi pause_active_cpl, & pause_active_ocn, & pause_active_wav, & + pause_active_iac, & pause_active_glc, & pause_active_ice, & pause_active_rof, & @@ -394,6 +404,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi data_assimilation_cpl, & data_assimilation_ocn, & data_assimilation_wav, & + data_assimilation_iac, & data_assimilation_glc, & data_assimilation_ice, & data_assimilation_rof, & @@ -407,6 +418,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi atm_cpl_offset, lnd_cpl_offset, ocn_cpl_offset, & ice_cpl_offset, glc_cpl_dt, glc_cpl_offset, glc_avg_period, & wav_cpl_dt, wav_cpl_offset, esp_cpl_dt, esp_cpl_offset, & + iac_cpl_dt, iac_cpl_offset, & rof_cpl_dt, rof_cpl_offset, esp_run_on_pause, end_restart !------------------------------------------------------------------------------- ! Notes: @@ -421,6 +433,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi SyncClock%ECP(seq_timemgr_nclock_rof)%EClock => EClock_rof SyncClock%ECP(seq_timemgr_nclock_wav)%EClock => EClock_wav SyncClock%ECP(seq_timemgr_nclock_esp)%EClock => EClock_esp + SyncClock%ECP(seq_timemgr_nclock_iac)%EClock => EClock_iac call mpi_comm_rank(mpicom,iam,ierr) @@ -451,6 +464,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi pause_active_ice = .false. pause_active_rof = .false. pause_active_lnd = .false. + pause_active_iac = .false. data_assimilation_atm = .false. data_assimilation_cpl = .false. data_assimilation_ocn = .false. @@ -459,6 +473,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi data_assimilation_ice = .false. data_assimilation_rof = .false. data_assimilation_lnd = .false. + data_assimilation_iac = .false. history_option = seq_timemgr_optNever history_n = -1 @@ -487,6 +502,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi rof_cpl_dt = 0 wav_cpl_dt = 0 esp_cpl_dt = 0 + iac_cpl_dt = 0 atm_cpl_offset = 0 lnd_cpl_offset = 0 ice_cpl_offset = 0 @@ -495,6 +511,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi rof_cpl_offset = 0 wav_cpl_offset = 0 esp_cpl_offset = 0 + iac_cpl_offset = 0 esp_run_on_pause = .true. end_restart = .true. @@ -550,6 +567,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi if (glc_cpl_dt == 0) glc_cpl_dt = atm_cpl_dt ! Copy atm coupling time into glc if (wav_cpl_dt == 0) wav_cpl_dt = atm_cpl_dt ! Copy atm coupling time into wav if (esp_cpl_dt == 0) esp_cpl_dt = atm_cpl_dt ! Copy atm coupling time into esp + if (iac_cpl_dt == 0) iac_cpl_dt = atm_cpl_dt ! Copy atm coupling time into iac if ( ref_ymd == 0 ) then ref_ymd = start_ymd @@ -632,6 +650,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi write(logunit,F0I) trim(subname),' rof_cpl_dt = ',rof_cpl_dt write(logunit,F0I) trim(subname),' wav_cpl_dt = ',wav_cpl_dt write(logunit,F0I) trim(subname),' esp_cpl_dt = ',esp_cpl_dt + write(logunit,F0I) trim(subname),' iac_cpl_dt = ',iac_cpl_dt write(logunit,F0I) trim(subname),' atm_cpl_offset = ',atm_cpl_offset write(logunit,F0I) trim(subname),' lnd_cpl_offset = ',lnd_cpl_offset write(logunit,F0I) trim(subname),' ice_cpl_offset = ',ice_cpl_offset @@ -640,6 +659,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi write(logunit,F0I) trim(subname),' rof_cpl_offset = ',rof_cpl_offset write(logunit,F0I) trim(subname),' wav_cpl_offset = ',wav_cpl_offset write(logunit,F0I) trim(subname),' esp_cpl_offset = ',esp_cpl_offset + write(logunit,F0I) trim(subname),' iac_cpl_offset = ',iac_cpl_offset write(logunit,F0A) ' ' !--------------------------------------------------------------------------- @@ -651,10 +671,10 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi lnd_cpl_dt /= atm_cpl_dt .or. & ice_cpl_dt /= atm_cpl_dt .or. & ocn_cpl_dt <= 0 .or. glc_cpl_dt <= 0 .or. rof_cpl_dt <=0 .or. & - wav_cpl_dt <=0 .or. esp_cpl_dt <=0) then + wav_cpl_dt <=0 .or. esp_cpl_dt <=0 .or. iac_cpl_dt <=0) then write(logunit,*) trim(subname),' ERROR: aliogrwe _cpl_dt = ', & atm_cpl_dt, lnd_cpl_dt, ice_cpl_dt, ocn_cpl_dt, glc_cpl_dt, & - rof_cpl_dt, wav_cpl_dt, esp_cpl_dt + rof_cpl_dt, wav_cpl_dt, esp_cpl_dt, iac_cpl_dt call shr_sys_abort( subname//': ERROR coupling intervals invalid' ) end if ! --- Coupling offsets -------------------------------------------------- @@ -665,10 +685,12 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi abs(rof_cpl_offset) > rof_cpl_dt .or. & abs(wav_cpl_offset) > wav_cpl_dt .or. & abs(esp_cpl_offset) > esp_cpl_dt .or. & + abs(iac_cpl_offset) > iac_cpl_dt .or. & abs(ocn_cpl_offset) > ocn_cpl_dt) then write(logunit,*) trim(subname),' ERROR: aliogrwe _cpl_offset = ', & atm_cpl_offset, lnd_cpl_offset, ice_cpl_offset, ocn_cpl_offset, & - glc_cpl_offset, rof_cpl_offset, wav_cpl_offset, esp_cpl_offset + glc_cpl_offset, rof_cpl_offset, wav_cpl_offset, esp_cpl_offset, & + iac_cpl_offset call shr_sys_abort( subname//': ERROR coupling offsets invalid' ) end if @@ -702,6 +724,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi call shr_mpi_bcast(pause_active_ice, mpicom ) call shr_mpi_bcast(pause_active_rof, mpicom ) call shr_mpi_bcast(pause_active_lnd, mpicom ) + call shr_mpi_bcast(pause_active_iac, mpicom ) call shr_mpi_bcast(data_assimilation_atm, mpicom ) call shr_mpi_bcast(data_assimilation_cpl, mpicom ) call shr_mpi_bcast(data_assimilation_ocn, mpicom ) @@ -710,6 +733,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi call shr_mpi_bcast(data_assimilation_ice, mpicom ) call shr_mpi_bcast(data_assimilation_rof, mpicom ) call shr_mpi_bcast(data_assimilation_lnd, mpicom ) + call shr_mpi_bcast(data_assimilation_iac, mpicom ) call shr_mpi_bcast( history_n, mpicom ) call shr_mpi_bcast( history_option, mpicom ) @@ -738,6 +762,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi call shr_mpi_bcast( rof_cpl_dt, mpicom ) call shr_mpi_bcast( wav_cpl_dt, mpicom ) call shr_mpi_bcast( esp_cpl_dt, mpicom ) + call shr_mpi_bcast( iac_cpl_dt, mpicom ) call shr_mpi_bcast( atm_cpl_offset, mpicom ) call shr_mpi_bcast( lnd_cpl_offset, mpicom ) call shr_mpi_bcast( ice_cpl_offset, mpicom ) @@ -746,6 +771,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi call shr_mpi_bcast( rof_cpl_offset, mpicom ) call shr_mpi_bcast( wav_cpl_offset, mpicom ) call shr_mpi_bcast( esp_cpl_offset, mpicom ) + call shr_mpi_bcast( iac_cpl_offset, mpicom ) call shr_mpi_bcast( esp_run_on_pause, mpicom ) call shr_mpi_bcast( end_restart, mpicom ) @@ -787,6 +813,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi pause_active(seq_timemgr_nclock_ice) = pause_active_ice pause_active(seq_timemgr_nclock_rof) = pause_active_rof pause_active(seq_timemgr_nclock_lnd) = pause_active_lnd + pause_active(seq_timemgr_nclock_iac) = pause_active_iac ! Figure out which compoments need to do post-data assimilation processing data_assimilation_active(seq_timemgr_nclock_atm) = data_assimilation_atm @@ -797,6 +824,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi data_assimilation_active(seq_timemgr_nclock_ice) = data_assimilation_ice data_assimilation_active(seq_timemgr_nclock_rof) = data_assimilation_rof data_assimilation_active(seq_timemgr_nclock_lnd) = data_assimilation_lnd + data_assimilation_active(seq_timemgr_nclock_iac) = data_assimilation_iac if ( ANY(pause_active) .and. & (trim(pause_option) /= seq_timemgr_optNONE) .and. & @@ -841,6 +869,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi dtime(seq_timemgr_nclock_rof ) = rof_cpl_dt dtime(seq_timemgr_nclock_wav ) = wav_cpl_dt dtime(seq_timemgr_nclock_esp ) = esp_cpl_dt + dtime(seq_timemgr_nclock_iac ) = iac_cpl_dt ! --- this finds the min of dtime excluding the driver value --- dtime(seq_timemgr_nclock_drv) = maxval(dtime) @@ -1003,6 +1032,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi offset(seq_timemgr_nclock_rof) = rof_cpl_offset offset(seq_timemgr_nclock_wav) = wav_cpl_offset offset(seq_timemgr_nclock_esp) = esp_cpl_offset + offset(seq_timemgr_nclock_iac) = iac_cpl_offset call seq_timemgr_alarmGet(SyncClock%EAlarm(seq_timemgr_nclock_drv, & seq_timemgr_nalarm_restart), IntSec=drvRestInterval) @@ -1084,6 +1114,15 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi RefTime = OffsetTime, & alarmname = trim(seq_timemgr_alarm_wavrun)) + call ESMF_TimeIntervalSet( TimeStep, s=offset(seq_timemgr_nclock_iac), rc=rc ) + OffsetTime = CurrTime + TimeStep + call seq_timemgr_alarmInit(SyncClock%ECP(seq_timemgr_nclock_drv)%EClock, & + EAlarm = SyncClock%EAlarm(seq_timemgr_nclock_drv,seq_timemgr_nalarm_iacrun), & + option = seq_timemgr_optNSeconds, & + opt_n = dtime(seq_timemgr_nclock_iac), & + RefTime = OffsetTime, & + alarmname = trim(seq_timemgr_alarm_iacrun)) + call ESMF_TimeIntervalSet( TimeStep, s=offset(seq_timemgr_nclock_glc), rc=rc ) OffsetTime = CurrTime + TimeStep call ESMF_TimeIntervalSet( TimeStep, s=-offset(seq_timemgr_nclock_drv), rc=rc ) @@ -2244,6 +2283,8 @@ logical function seq_timemgr_data_assimilation_active(component_ntype) seq_timemgr_data_assimilation_active = data_assimilation_active(seq_timemgr_nclock_rof) case ('lnd') seq_timemgr_data_assimilation_active = data_assimilation_active(seq_timemgr_nclock_lnd) + case ('iac') + seq_timemgr_data_assimilation_active = data_assimilation_active(seq_timemgr_nclock_iac) case ('esp') seq_timemgr_data_assimilation_active = .FALSE. case default diff --git a/src/drivers/mct/unit_test/CMakeLists.txt b/src/drivers/mct/unit_test/CMakeLists.txt index fb27128d8574..289a49c8599e 100644 --- a/src/drivers/mct/unit_test/CMakeLists.txt +++ b/src/drivers/mct/unit_test/CMakeLists.txt @@ -9,6 +9,7 @@ add_definitions( -DNUM_COMP_INST_WAV=1 -DNUM_COMP_INST_ROF=1 -DNUM_COMP_INST_ESP=1 + -DNUM_COMP_INST_IAC=1 ) # The following definitions are needed when building with the mpi-serial library diff --git a/src/drivers/nuopc/cime_config/buildnml b/src/drivers/nuopc/cime_config/buildnml index 05e2c4f46e19..0acc9c4ea7d4 100755 --- a/src/drivers/nuopc/cime_config/buildnml +++ b/src/drivers/nuopc/cime_config/buildnml @@ -304,6 +304,7 @@ def _create_runseq(case, coupling_times): # Determine if there is a user run sequence file in CASEROOT, use it shutil.copy(user_file, rundir) shutil.copy(user_file, os.path.join(caseroot,"CaseDocs")) + logger.info("NUOPC run sequence: copying custom run sequence from case root") else: @@ -337,11 +338,14 @@ def _create_runseq(case, coupling_times): # for Q (aquaplanet) compsets runseq_input = os.path.join(input_dir, 'nuopc_runseq_Q') - elif ( (comp_atm == 'datm' and comp_ocn == "mom" and comp_ice == "dice") or - (comp_atm == 'datm' and comp_ocn == "mom" and comp_ice == "cice") or + elif ( (comp_atm == 'datm' and (comp_ocn == "mom" or comp_ocn == 'pop') and comp_ice == "dice") or + (comp_atm == 'datm' and (comp_ocn == "mom" or comp_ocn == 'pop') and comp_ice == "cice") or (comp_atm == 'datm' and comp_ocn == "docn" and comp_ice == "cice")): # for C, G and D compsets - runseq_input = os.path.join(input_dir, 'nuopc_runseq_C_G_D') + if comp_wav == 'ww': + runseq_input = os.path.join(input_dir, 'nuopc_runseq_C_G_D_ww3') + else: + runseq_input = os.path.join(input_dir, 'nuopc_runseq_C_G_D_swav') elif (comp_atm == 'datm' and comp_lnd == "clm"): # for I compsets @@ -358,8 +362,13 @@ def _create_runseq(case, coupling_times): runseq_input = os.path.join(input_dir, 'nuopc_runseq_B') elif (comp_atm == 'fv3gfs' and comp_ocn == "mom" and comp_ice == 'cice'): - # for NEMS fully coupled - runseq_input = os.path.join(input_dir, 'nuopc_runseq_NEMS') + # for NEMS fully coupled + if case.get_value("CONTINUE_RUN"): + logger.info("NUOPC run sequence: warm start (concurrent)") + runseq_input = os.path.join(input_dir, 'nuopc_runseq_NEMS.warm') + else: + logger.info("NUOPC run sequence: cold start (sequential)") + runseq_input = os.path.join(input_dir, 'nuopc_runseq_NEMS.cold') else: # default diff --git a/src/drivers/nuopc/cime_config/config_component.xml b/src/drivers/nuopc/cime_config/config_component.xml index b60f583f261d..0ff2d12b7b0a 100644 --- a/src/drivers/nuopc/cime_config/config_component.xml +++ b/src/drivers/nuopc/cime_config/config_component.xml @@ -1563,15 +1563,6 @@ wav2ocn state mapping file - - char - none,npfix,cart3d,cart3d_diag,cart3d_uvw,cart3d_uvw_diag - cart3d - run_domain - env_run.xml - vector mapping option - - char 1.0e-02 diff --git a/src/drivers/nuopc/cime_config/config_component_cesm.xml b/src/drivers/nuopc/cime_config/config_component_cesm.xml index 544da7e29af6..fe281c4a3249 100644 --- a/src/drivers/nuopc/cime_config/config_component_cesm.xml +++ b/src/drivers/nuopc/cime_config/config_component_cesm.xml @@ -201,7 +201,9 @@ 288 72 48 - 4 + + + 24 24 24 24 diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_A b/src/drivers/nuopc/cime_config/nuopc_runseq_A index 580f52152b7f..de7e7932e148 100644 --- a/src/drivers/nuopc/cime_config/nuopc_runseq_A +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_A @@ -1,7 +1,6 @@ runSeq:: @ocn_cpl_dt #ocean coupling step MED med_phases_prep_ocn_accum_avg - MED med_connectors_prep_med2ocn MED -> OCN :remapMethod=redist @atm_cpl_dt # atmosphere coupling step MED med_phases_prep_ocn_map @@ -10,31 +9,24 @@ runSeq:: MED med_phases_prep_ocn_accum_fast MED med_phases_ocnalb_run MED med_phases_prep_ice - MED med_connectors_prep_med2ice MED -> ICE :remapMethod=redist MED med_phases_prep_rof_accum_fast MED med_phases_prep_rof_avg - MED med_connectors_prep_med2rof MED -> ROF :remapMethod=redist ICE ROF ICE -> MED :remapMethod=redist - MED med_connectors_post_ice2med MED med_fraction_set ROF -> MED :remapMethod=redist - MED med_connectors_post_rof2med MED med_phases_prep_atm - MED med_connectors_prep_med2atm MED -> ATM :remapMethod=redist ATM ATM -> MED :remapMethod=redist - MED med_connectors_post_atm2med MED med_phases_history_write MED med_phases_profile @ OCN OCN -> MED :remapMethod=redist - MED med_connectors_post_ocn2med MED med_phases_restart_write @ :: diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_ADLND b/src/drivers/nuopc/cime_config/nuopc_runseq_ADLND index b59608892b13..2d19210b6762 100644 --- a/src/drivers/nuopc/cime_config/nuopc_runseq_ADLND +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_ADLND @@ -3,7 +3,6 @@ runSeq:: LND LND -> MED :remapMethod=redist MED med_fraction_set - MED med_connectors_post_lnd2med MED med_phases_history_write MED med_phases_profile MED med_phases_restart_write diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_ADWAV b/src/drivers/nuopc/cime_config/nuopc_runseq_ADWAV index c582a6dc1b5f..9685fea7974b 100644 --- a/src/drivers/nuopc/cime_config/nuopc_runseq_ADWAV +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_ADWAV @@ -2,7 +2,6 @@ runSeq:: @wav_cpl_dt # wave coupling step WAV WAV -> MED :remapMethod=redist - MED med_connectors_post_wav2med MED med_fraction_set MED med_phases_history_write MED med_phases_profile diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_B b/src/drivers/nuopc/cime_config/nuopc_runseq_B index 79b4d8dd8e7e..fac2c5ee2073 100644 --- a/src/drivers/nuopc/cime_config/nuopc_runseq_B +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_B @@ -1,7 +1,6 @@ runSeq:: @ocn_cpl_dt # ocean coupling step MED med_phases_prep_ocn_accum_avg - MED med_connectors_prep_med2ocn MED -> OCN :remapMethod=redist @atm_cpl_dt # atmosphere coupling step MED med_phases_prep_ocn_map @@ -10,30 +9,23 @@ runSeq:: MED med_phases_prep_ocn_accum_fast MED med_phases_ocnalb_run MED med_phases_prep_lnd - MED med_connectors_prep_med2lnd MED -> LND :remapMethod=redist MED med_phases_prep_ice - MED med_connectors_prep_med2ice MED -> ICE :remapMethod=redist ICE LND ICE -> MED :remapMethod=redist - MED med_connectors_post_ice2med MED med_fraction_set LND -> MED :remapMethod=redist - MED med_connectors_post_lnd2med MED med_phases_prep_atm - MED med_connectors_prep_med2atm MED -> ATM :remapMethod=redist ATM ATM -> MED :remapMethod=redist - MED med_connectors_post_atm2med MED med_phases_history_write MED med_phases_profile @ OCN OCN -> MED :remapMethod=redist - MED med_connectors_post_ocn2med MED med_phases_restart_write @ :: diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_C_G_D_swav b/src/drivers/nuopc/cime_config/nuopc_runseq_C_G_D_swav new file mode 100644 index 000000000000..2992420480df --- /dev/null +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_C_G_D_swav @@ -0,0 +1,27 @@ +runSeq:: +@ocn_cpl_dt #ocean coupling step + MED med_phases_prep_ocn_accum_avg + MED -> OCN :remapMethod=redist + @atm_cpl_dt # atmosphere coupling step + MED med_phases_prep_ocn_map + MED med_phases_aofluxes_run + MED med_phases_prep_ocn_merge + MED med_phases_prep_ocn_accum_fast + MED med_phases_ocnalb_run + MED med_phases_prep_ice + MED -> ICE :remapMethod=redist + ICE + ROF + ATM + ICE -> MED :remapMethod=redist + MED med_fraction_set + ROF -> MED :remapMethod=redist + ATM -> MED :remapMethod=redist + MED med_phases_history_write + MED med_phases_profile + @ + OCN + OCN -> MED :remapMethod=redist + MED med_phases_restart_write +@ +:: diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_C_G_D_ww3 b/src/drivers/nuopc/cime_config/nuopc_runseq_C_G_D_ww3 new file mode 100644 index 000000000000..a35989eaf516 --- /dev/null +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_C_G_D_ww3 @@ -0,0 +1,31 @@ +runSeq:: +@atm_cpl_dt # Assume that atm_cpl_dt >= ocn_cpl_dt + MED med_phases_prep_ocn_map # map to ocean (including wav) + MED med_phases_aofluxes_run # run atm/ocn flux calculation + MED med_phases_prep_ocn_merge + MED med_phases_prep_ocn_accum_fast + MED med_phases_prep_ocn_accum_avg + MED med_phases_ocnalb_run + MED -> OCN :remapMethod=redist + MED med_phases_prep_ice + MED -> ICE :remapMethod=redist + MED med_phases_prep_wav + MED -> WAV :remapMethod=redist + ICE + ROF + WAV + ATM + ICE -> MED :remapMethod=redist + MED med_fraction_set + ROF -> MED :remapMethod=redist + WAV -> MED :remapMethod=redist + ATM -> MED :remapMethod=redist + @ocn_cpl_dt #ocean coupling step + OCN + @ + OCN -> MED :remapMethod=redist + MED med_phases_restart_write + MED med_phases_history_write + MED med_phases_profile +@ +:: diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_C_wav b/src/drivers/nuopc/cime_config/nuopc_runseq_C_wav new file mode 100644 index 000000000000..d4909acee67a --- /dev/null +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_C_wav @@ -0,0 +1,31 @@ +runSeq:: +@86400 #ocean coupling step + MED med_phases_prep_ocn_accum_avg + MED -> OCN :remapMethod=redist + @21600 # atmosphere coupling step + MED med_phases_prep_ocn_map + MED med_phases_aofluxes_run + MED med_phases_prep_ocn_merge + MED med_phases_prep_ocn_accum_fast + MED med_phases_ocnalb_run + MED med_phases_prep_ice + MED med_phases_prep_wav + MED -> ICE :remapMethod=redist + MED -> WAV :remapMethod=redist + ICE + ROF + WAV + ATM + ICE -> MED :remapMethod=redist + MED med_fraction_set + ROF -> MED :remapMethod=redist + WAV -> MED :remapMethod=redist + ATM -> MED :remapMethod=redist + MED med_phases_history_write + MED med_phases_profile + @ + OCN + OCN -> MED :remapMethod=redist + MED med_phases_restart_write +@ +:: diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_F b/src/drivers/nuopc/cime_config/nuopc_runseq_F index 2bd784fda2bf..257180cb18ed 100644 --- a/src/drivers/nuopc/cime_config/nuopc_runseq_F +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_F @@ -2,21 +2,16 @@ runSeq:: @ocn_cpl_dt #ocean coupling step @atm_cpl_dt # atmosphere coupling step MED med_phases_prep_ocn_accum_avg - MED med_connectors_prep_med2ocn MED -> OCN :remapMethod=redist MED med_phases_prep_lnd - MED med_connectors_prep_med2lnd MED -> LND :remapMethod=redist MED med_phases_prep_ice - MED med_connectors_prep_med2ice MED -> ICE :remapMethod=redist ICE LND OCN OCN -> MED :remapMethod=redist - MED med_connectors_post_ocn2med ICE -> MED :remapMethod=redist - MED med_connectors_post_ice2med MED med_fraction_set MED med_phases_prep_ocn_map MED med_phases_aofluxes_run @@ -24,13 +19,10 @@ runSeq:: MED med_phases_prep_ocn_accum_fast MED med_phases_ocnalb_run LND -> MED :remapMethod=redist - MED med_connectors_post_lnd2med MED med_phases_prep_atm - MED med_connectors_prep_med2atm MED -> ATM :remapMethod=redist ATM ATM -> MED :remapMethod=redist - MED med_connectors_post_atm2med MED med_phases_history_write MED med_phases_profile @ diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_I b/src/drivers/nuopc/cime_config/nuopc_runseq_I index c8b3d4cf1f5a..38a0db1ac003 100644 --- a/src/drivers/nuopc/cime_config/nuopc_runseq_I +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_I @@ -1,15 +1,12 @@ runSeq:: @atm_cpl_dt # atmosphere coupling step MED med_phases_prep_lnd - MED med_connectors_prep_med2lnd MED -> LND :remapMethod=redist LND LND -> MED :remapMethod=redist - MED med_connectors_post_lnd2med MED med_fraction_set ATM ATM -> MED :remapMethod=redist - MED med_connectors_post_atm2med MED med_phases_history_write MED med_phases_profile MED med_phases_restart_write diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_I_mosart b/src/drivers/nuopc/cime_config/nuopc_runseq_I_mosart index 57cd78fe8884..c9fe228db2ba 100644 --- a/src/drivers/nuopc/cime_config/nuopc_runseq_I_mosart +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_I_mosart @@ -1,24 +1,19 @@ runSeq:: @rof_cpl_dt # rof coupling step MED med_phases_prep_rof_avg - MED med_connectors_prep_med2rof MED -> ROF :remapMethod=redist ROF - ROF -> MED :remapMethod=redist @atm_cpl_dt # atmosphere coupling step MED med_phases_prep_lnd - MED med_connectors_prep_med2lnd MED -> LND :remapMethod=redist LND LND -> MED :remapMethod=redist - MED med_connectors_post_lnd2med MED med_phases_prep_rof_accum_fast ATM ATM -> MED :remapMethod=redist - MED med_connectors_post_atm2med MED med_phases_profile @ - MED med_connectors_post_rof2med + ROF -> MED :remapMethod=redist MED med_phases_history_write MED med_phases_restart_write @ diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_NEMS b/src/drivers/nuopc/cime_config/nuopc_runseq_NEMS index 63475e131913..433da2863154 100644 --- a/src/drivers/nuopc/cime_config/nuopc_runseq_NEMS +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_NEMS @@ -1,22 +1,17 @@ runSeq:: @ocn_cpl_dt #slow coupling step (ocean) MED med_phases_prep_ocn_accum_avg - MED med_connectors_prep_med2ocn MED -> OCN :remapMethod=redist OCN @atm_cpl_dt # fast coupling step (atm, ice) MED med_phases_prep_atm - MED med_connectors_prep_med2atm MED -> ATM :remapMethod=redist ATM ATM -> MED :remapMethod=redist - MED med_connectors_post_atm2med MED med_phases_prep_ice - MED med_connectors_prep_med2ice MED -> ICE :remapMethod=redist ICE ICE -> MED :remapMethod=redist - MED med_connectors_post_ice2med MED med_fraction_set MED med_phases_prep_ocn_map MED med_phases_aofluxes_run @@ -26,7 +21,6 @@ runSeq:: MED med_phases_profile @ OCN -> MED :remapMethod=redist - MED med_connectors_post_ocn2med MED med_phases_restart_write @ :: diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_NEMS.cold b/src/drivers/nuopc/cime_config/nuopc_runseq_NEMS.cold new file mode 100644 index 000000000000..4027737e037d --- /dev/null +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_NEMS.cold @@ -0,0 +1,26 @@ +runSeq:: +@ocn_cpl_dt #slow coupling step (ocean) + @atm_cpl_dt # fast coupling step (atm, ice) + MED med_phases_prep_atm + MED -> ATM :remapMethod=redist + ATM + ATM -> MED :remapMethod=redist + MED med_phases_prep_ice + MED -> ICE :remapMethod=redist + ICE + ICE -> MED :remapMethod=redist + MED med_fraction_set + MED med_phases_prep_ocn_map + MED med_phases_aofluxes_run + MED med_phases_prep_ocn_merge + MED med_phases_prep_ocn_accum_fast + MED med_phases_history_write + MED med_phases_profile + @ + MED med_phases_prep_ocn_accum_avg + MED -> OCN :remapMethod=redist + OCN + OCN -> MED :remapMethod=redist + MED med_phases_restart_write +@ +:: diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_NEMS.warm b/src/drivers/nuopc/cime_config/nuopc_runseq_NEMS.warm new file mode 100644 index 000000000000..cbb0cf821cec --- /dev/null +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_NEMS.warm @@ -0,0 +1,26 @@ +runSeq:: +@ocn_cpl_dt #slow coupling step (ocean) + MED med_phases_prep_ocn_accum_avg + MED -> OCN :remapMethod=redist + OCN + @atm_cpl_dt # fast coupling step (atm, ice) + MED med_phases_prep_atm + MED med_phases_prep_ice + MED -> ATM :remapMethod=redist + MED -> ICE :remapMethod=redist + ATM + ICE + ATM -> MED :remapMethod=redist + ICE -> MED :remapMethod=redist + MED med_fraction_set + MED med_phases_prep_ocn_map + MED med_phases_aofluxes_run + MED med_phases_prep_ocn_merge + MED med_phases_prep_ocn_accum_fast + MED med_phases_history_write + MED med_phases_profile + @ + OCN -> MED :remapMethod=redist + MED med_phases_restart_write +@ +:: diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_Q b/src/drivers/nuopc/cime_config/nuopc_runseq_Q index 16a7ca3d739c..e6df31da2758 100644 --- a/src/drivers/nuopc/cime_config/nuopc_runseq_Q +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_Q @@ -2,11 +2,9 @@ runSeq:: @ocn_cpl_dt #ocean coupling step @atm_cpl_dt # atmosphere coupling step MED med_phases_prep_ocn_accum_avg - MED med_connectors_prep_med2ocn MED -> OCN :remapMethod=redist OCN OCN -> MED :remapMethod=redist - MED med_connectors_post_ocn2med MED med_fraction_set MED med_phases_prep_ocn_map MED med_phases_aofluxes_run @@ -14,11 +12,9 @@ runSeq:: MED med_phases_prep_ocn_accum_fast MED med_phases_ocnalb_run MED med_phases_prep_atm - MED med_connectors_prep_med2atm MED -> ATM :remapMethod=redist ATM ATM -> MED :remapMethod=redist - MED med_connectors_post_atm2med MED med_phases_history_write MED med_phases_profile @ diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_X b/src/drivers/nuopc/cime_config/nuopc_runseq_X index 48ec4588a897..20710a4791b7 100644 --- a/src/drivers/nuopc/cime_config/nuopc_runseq_X +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_X @@ -1,7 +1,6 @@ runSeq:: @ocn_cpl_dt #ocean coupling step MED med_phases_prep_ocn_accum_avg - MED med_connectors_prep_med2ocn MED -> OCN :remapMethod=redist @atm_cpl_dt # atmosphere coupling step MED med_phases_prep_ocn_map @@ -10,49 +9,36 @@ runSeq:: MED med_phases_prep_ocn_accum_fast MED med_phases_ocnalb_run MED med_phases_prep_lnd - MED med_connectors_prep_med2lnd MED -> LND :remapMethod=redist MED med_phases_prep_ice - MED med_connectors_prep_med2ice MED -> ICE :remapMethod=redist MED med_phases_prep_wav - MED med_connectors_prep_med2wav MED -> WAV :remapMethod=redist MED med_phases_prep_rof_accum_fast MED med_phases_prep_rof_avg - MED med_connectors_prep_med2rof MED -> ROF :remapMethod=redist ICE LND ROF WAV ICE -> MED :remapMethod=redist - MED med_connectors_post_ice2med MED med_fraction_set LND -> MED :remapMethod=redist - MED med_connectors_post_lnd2med ROF -> MED :remapMethod=redist - MED med_connectors_post_rof2med MED med_phases_prep_glc - MED med_connectors_prep_med2glc MED -> GLC :remapMethod=redist MED med_phases_prep_atm - MED med_connectors_prep_med2atm MED -> ATM :remapMethod=redist ATM GLC WAV -> MED :remapMethod=redist - MED med_connectors_post_wav2med GLC -> MED :remapMethod=redist - MED med_connectors_post_glc2med ATM -> MED :remapMethod=redist - MED med_connectors_post_atm2med MED med_phases_history_write MED med_phases_profile @ OCN OCN -> MED :remapMethod=redist - MED med_connectors_post_ocn2med MED med_phases_restart_write @ :: diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_default b/src/drivers/nuopc/cime_config/nuopc_runseq_default index 1611e71268e4..66ab62b7256a 100644 --- a/src/drivers/nuopc/cime_config/nuopc_runseq_default +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_default @@ -1,7 +1,6 @@ runSeq:: @ocn_cpl_dt #ocean coupling step MED med_phases_prep_ocn_accum_avg - MED med_connectors_prep_med2ocn MED -> OCN :remapMethod=redist @atm_cpl_dt # atmosphere coupling step MED med_phases_prep_ocn_map @@ -10,48 +9,35 @@ runSeq:: MED med_phases_prep_ocn_accum_fast MED med_phases_ocnalb_run MED med_phases_prep_lnd - MED med_connectors_prep_med2lnd MED -> LND :remapMethod=redist MED med_phases_prep_ice - MED med_connectors_prep_med2ice MED -> ICE :remapMethod=redist MED med_phases_prep_wav - MED med_connectors_prep_med2wav MED -> WAV :remapMethod=redist MED med_phases_prep_rof - MED med_connectors_prep_med2rof MED -> ROF :remapMethod=redist ICE LND ROF WAV ICE -> MED :remapMethod=redist - MED med_connectors_post_ice2med MED med_fraction_set LND -> MED :remapMethod=redist - MED med_connectors_post_lnd2med ROF -> MED :remapMethod=redist - MED med_connectors_post_rof2med MED med_phases_prep_glc - MED med_connectors_prep_med2glc MED -> GLC :remapMethod=redist MED med_phases_prep_atm - MED med_connectors_prep_med2atm MED -> ATM :remapMethod=redist ATM GLC WAV -> MED :remapMethod=redist - MED med_connectors_post_wav2med GLC -> MED :remapMethod=redist - MED med_connectors_post_glc2med ATM -> MED :remapMethod=redist - MED med_connectors_post_atm2med MED med_phases_history_write MED med_phases_profile @ OCN OCN -> MED :remapMethod=redist - MED med_connectors_post_ocn2med MED med_phases_restart_write @ :: \ No newline at end of file diff --git a/src/drivers/nuopc/cime_driver/esmApp.F90 b/src/drivers/nuopc/cime_driver/esmApp.F90 index 664c96e4532c..2c38bbe098c3 100644 --- a/src/drivers/nuopc/cime_driver/esmApp.F90 +++ b/src/drivers/nuopc/cime_driver/esmApp.F90 @@ -4,36 +4,52 @@ program esmApp ! Generic ESM application driver !----------------------------------------------------------------------------- - use ESMF, only : ESMF_Initialize, ESMF_CALKIND_GREGORIAN, ESMF_LOGKIND_MULTI - use ESMF, only : ESMF_END_ABORT, ESMF_LogFoundError, ESMF_Finalize, ESMF_LOGERR_PASSTHRU - use ESMF, only : ESMF_GridCompSetServices, ESMF_GridCompFinalize, ESMF_LogSet, ESMF_LogWrite - use ESMF, only : ESMF_GridCompDestroy, ESMF_LOGMSG_INFO, ESMF_GridComp, ESMF_GridCompRun - use ESMF, only : ESMF_GridCompFinalize, ESMF_GridCompCreate, ESMF_GridCompInitialize - use ESMF, only : ESMF_LOGKIND_MULTI_ON_ERROR - use mpi, only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE - use NUOPC, only : NUOPC_FieldDictionarySetup - use ensemble_driver, only : SetServices - use shr_pio_mod, only : shr_pio_init1, shr_pio_init2 + use ESMF, only : ESMF_Initialize, ESMF_CALKIND_GREGORIAN, ESMF_LOGKIND_MULTI + use ESMF, only : ESMF_END_ABORT, ESMF_LogFoundError, ESMF_Finalize, ESMF_LOGERR_PASSTHRU + use ESMF, only : ESMF_GridCompSetServices, ESMF_GridCompFinalize, ESMF_LogSet, ESMF_LogWrite + use ESMF, only : ESMF_GridCompDestroy, ESMF_LOGMSG_INFO, ESMF_GridComp, ESMF_GridCompRun + use ESMF, only : ESMF_GridCompFinalize, ESMF_GridCompCreate, ESMF_GridCompInitialize + use ESMF, only : ESMF_LOGKIND_MULTI_ON_ERROR + use mpi, only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE + use NUOPC, only : NUOPC_FieldDictionarySetup + use ensemble_driver, only : SetServices + use shr_pio_mod, only : shr_pio_init1, shr_pio_init2 + implicit none + + ! local variables integer :: COMP_COMM integer :: rc, urc type(ESMF_GridComp) :: ensemble_driver_comp + !----------------------------------------------------------------------------- + ! Initiallize MPI + !----------------------------------------------------------------------------- + call MPI_init(rc) COMP_COMM = MPI_COMM_WORLD + + !----------------------------------------------------------------------------- + ! Initialize PIO + !----------------------------------------------------------------------------- + ! 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(8, "drv_in", COMP_COMM) - if(COMP_COMM .eq. MPI_COMM_NULL) then -! call shr_pio_init2( + + if (COMP_COMM .eq. MPI_COMM_NULL) then + ! call shr_pio_init2( call mpi_finalize(ierror=rc) stop endif + !----------------------------------------------------------------------------- ! Initialize ESMF !----------------------------------------------------------------------------- + #ifdef DEBUG call ESMF_Initialize(mpiCommunicator=COMP_COMM, logkindflag=ESMF_LOGKIND_MULTI, logappendflag=.false., & defaultCalkind=ESMF_CALKIND_GREGORIAN, ioUnitLBound=5001, ioUnitUBound=5101, rc=rc) @@ -77,6 +93,7 @@ program esmApp !----------------------------------------------------------------------------- ! SetServices for the ensemble driver Component !----------------------------------------------------------------------------- + call ESMF_GridCompSetServices(ensemble_driver_comp, SetServices, userRc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -118,6 +135,7 @@ program esmApp ! Call Finalize for the ensemble driver ! Destroy the ensemble driver !----------------------------------------------------------------------------- + call ESMF_GridCompFinalize(ensemble_driver_comp, userRc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -129,7 +147,7 @@ program esmApp call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_LogWrite("ESMF_GridCompDestroy called", ESMF_LOGMSG_INFO, rc=rc) -! call ESMF_LogSet(flush=.true., trace=.true., rc=rc) + ! call ESMF_LogSet(flush=.true., trace=.true., rc=rc) call ESMF_GridCompDestroy(ensemble_driver_comp, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & diff --git a/src/drivers/nuopc/cime_flds/esmFlds.F90 b/src/drivers/nuopc/cime_flds/esmFlds.F90 index 3fd260004932..bb9e348a1b62 100644 --- a/src/drivers/nuopc/cime_flds/esmFlds.F90 +++ b/src/drivers/nuopc/cime_flds/esmFlds.F90 @@ -33,14 +33,13 @@ module esmflds integer , public, parameter :: mapconsd = 3 integer , public, parameter :: mappatch = 4 integer , public, parameter :: mapfcopy = 5 - integer , public, parameter :: mapfiler = 6 - integer , public, parameter :: mapnstod = 7 ! nearest source to destination - integer , public, parameter :: mapnstod_consd = 8 ! nearest source to destination followed by conservative dst - integer , public, parameter :: mapnstod_consf = 9 ! nearest source to destination followed by conservative frac - integer , public, parameter :: nmappers = 9 + integer , public, parameter :: mapnstod = 6 ! nearest source to destination + integer , public, parameter :: mapnstod_consd = 7 ! nearest source to destination followed by conservative dst + integer , public, parameter :: mapnstod_consf = 8 ! nearest source to destination followed by conservative frac + integer , public, parameter :: nmappers = 8 character(len=*) , public, parameter :: mapnames(nmappers) = & - (/'bilnr', 'consf', 'consd', 'patch', 'fcopy', 'filer', 'nstod', 'nstod_consd', 'nstod_consf'/) + (/'bilnr', 'consf', 'consd', 'patch', 'fcopy', 'nstod', 'nstod_consd', 'nstod_consf'/) !----------------------------------------------- ! Set coupling mode @@ -803,7 +802,7 @@ subroutine shr_nuopc_fldList_Document_Mapping(logunit, med_coupling_active) !----------------------------------------------------------- !--------------------------------------- - ! Document mapping (also add albedo and aoflux) - move this routine to esmFlds.F90 + ! Document mapping (also add albedo and aoflux) !--------------------------------------- ! Loop over src components diff --git a/src/drivers/nuopc/cime_flds/esmFldsExchange.F90 b/src/drivers/nuopc/cime_flds/esmFldsExchange.F90 index 33b6b611263d..e5892360ce69 100644 --- a/src/drivers/nuopc/cime_flds/esmFldsExchange.F90 +++ b/src/drivers/nuopc/cime_flds/esmFldsExchange.F90 @@ -27,7 +27,6 @@ subroutine esmFldsExchange(gcomp, phase, rc) use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_chkerr use shr_nuopc_methods_mod , only : fldchk => shr_nuopc_methods_FB_FldChk use med_internalstate_mod , only : InternalState - use glc_elevclass_mod , only : glc_elevclass_as_string use shr_sys_mod , only : shr_sys_abort use esmFlds , only : shr_nuopc_fldList_type use esmFlds , only : addfld => shr_nuopc_fldList_AddFld @@ -36,7 +35,7 @@ subroutine esmFldsExchange(gcomp, phase, rc) use esmflds , only : compmed, compatm, complnd, compocn use esmflds , only : compice, comprof, compwav, compglc, ncomps use esmflds , only : mapbilnr, mapconsf, mapconsd, mappatch - use esmflds , only : mapfcopy, mapfiler, mapnstod, mapnstod_consd, mapnstod_consf + use esmflds , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf use esmflds , only : fldListTo, fldListFr, fldListMed_aoflux, fldListMed_ocnalb use esmFlds , only : coupling_mode @@ -47,44 +46,43 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! local variables: type(InternalState) :: is_local - integer :: ice_ncat ! number of sea ice thickness categories - integer :: glc_nec ! number of land-ice elevation classes - integer :: max_megan - integer :: max_ddep - integer :: max_fire logical :: flds_i2o_per_cat integer :: dbrc integer :: num, i, n integer :: n1, n2, n3, n4 - character(len=4) :: iso(4) - character(len=3) :: cnum + logical :: isPresent + character(len=5) :: iso(2) character(len=CL) :: cvalue character(len=CS) :: name, fldname - character(len=CX) :: atm2ice_fmap, atm2ice_smap, atm2ice_vmap - character(len=CX) :: atm2ocn_fmap, atm2ocn_smap, atm2ocn_vmap - character(len=CX) :: atm2lnd_fmap, atm2lnd_smap - character(len=CX) :: glc2lnd_smap, glc2lnd_fmap - character(len=CX) :: glc2ice_rmap - character(len=CX) :: glc2ocn_liq_rmap, glc2ocn_ice_rmap - character(len=CX) :: ice2atm_fmap, ice2atm_smap - character(len=CX) :: ocn2atm_fmap, ocn2atm_smap - character(len=CX) :: lnd2atm_fmap, lnd2atm_smap - character(len=CX) :: lnd2glc_fmap, lnd2glc_smap - character(len=CX) :: lnd2rof_fmap - character(len=CX) :: rof2lnd_fmap - character(len=CX) :: rof2ocn_fmap, rof2ocn_ice_rmap, rof2ocn_liq_rmap - character(len=CX) :: atm2wav_smap, ice2wav_smap, ocn2wav_smap - character(len=CX) :: wav2ocn_smap + character(len=CX) :: atm2ice_fmap='unset', atm2ice_smap='unset', atm2ice_vmap='unset' + character(len=CX) :: atm2ocn_fmap='unset', atm2ocn_smap='unset', atm2ocn_vmap='unset' + character(len=CX) :: atm2lnd_fmap='unset', atm2lnd_smap='unset' + character(len=CX) :: glc2lnd_smap='unset', glc2lnd_fmap='unset' + character(len=CX) :: glc2ice_rmap='unset' + character(len=CX) :: glc2ocn_liq_rmap='unset', glc2ocn_ice_rmap='unset' + character(len=CX) :: ice2atm_fmap='unset', ice2atm_smap='unset' + character(len=CX) :: ocn2atm_fmap='unset', ocn2atm_smap='unset' + character(len=CX) :: lnd2atm_fmap='unset', lnd2atm_smap='unset' + character(len=CX) :: lnd2glc_fmap='unset', lnd2glc_smap='unset' + character(len=CX) :: lnd2rof_fmap='unset' + character(len=CX) :: rof2lnd_fmap='unset' + character(len=CX) :: rof2ocn_fmap='unset', rof2ocn_ice_rmap='unset', rof2ocn_liq_rmap='unset' + character(len=CX) :: atm2wav_smap='unset', ice2wav_smap='unset', ocn2wav_smap='unset' + character(len=CX) :: wav2ocn_smap='unset' logical :: flds_co2a ! use case logical :: flds_co2b ! use case logical :: flds_co2c ! use case character(len=64), allocatable :: flds(:) character(len=64), allocatable :: suffix(:) - character(len=*), parameter :: subname='(esmFldsExchange)' + character(len=*) , parameter :: subname='(esmFldsExchange)' !-------------------------------------- rc = ESMF_SUCCESS + iso(1) = '' + iso(2) = '_wiso' + + !--------------------------------------- ! Get the internal state !--------------------------------------- @@ -146,22 +144,10 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! mappings between the atm and ocn needed for these computations. !-------------------------------------- - !--------------------------- - ! For now hardwire these - !--------------------------- - - ! these must be less than or equal to the values in fd.yaml - max_megan = 20 - max_ddep = 80 - max_fire = 10 - glc_nec = 10 - ice_ncat = 5 - flds_i2o_per_cat = .true. - - iso(1) = '' - iso(2) = '_16O' - iso(3) = '_18O' - iso(4) = '_HDO' + call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) flds_i2o_per_cat + call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO) !---------------------------------------------------------- ! Initialize mapping file names @@ -169,137 +155,197 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to atm - call NUOPC_CompAttributeGet(gcomp, name='ice2atm_fmapname', value=ice2atm_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='ice2atm_fmapname', value=ice2atm_fmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('ice2atm_fmapname = '// trim(ice2atm_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('ice2atm_fmapname = '// trim(ice2atm_fmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='ice2atm_smapname', value=ice2atm_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='ice2atm_smapname', value=ice2atm_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('ice2atm_smapname = '// trim(ice2atm_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('ice2atm_smapname = '// trim(ice2atm_smap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='lnd2atm_fmapname', value=lnd2atm_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='lnd2atm_fmapname', value=lnd2atm_fmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('lnd2atm_fmapname = '// trim(lnd2atm_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('lnd2atm_fmapname = '// trim(lnd2atm_fmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='ocn2atm_smapname', value=ocn2atm_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='ocn2atm_smapname', value=ocn2atm_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('ocn2atm_smapname = '// trim(ocn2atm_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('ocn2atm_smapname = '// trim(ocn2atm_smap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='ocn2atm_fmapname', value=ocn2atm_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='ocn2atm_fmapname', value=ocn2atm_fmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('ocn2atm_fmapname = '// trim(ocn2atm_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('ocn2atm_fmapname = '// trim(ocn2atm_fmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='lnd2atm_smapname', value=lnd2atm_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='lnd2atm_smapname', value=lnd2atm_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('lnd2atm_smapname = '// trim(lnd2atm_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('lnd2atm_smapname = '// trim(lnd2atm_smap), ESMF_LOGMSG_INFO) + end if ! to lnd - call NUOPC_CompAttributeGet(gcomp, name='atm2lnd_fmapname', value=atm2lnd_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='atm2lnd_fmapname', value=atm2lnd_fmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('atm2lnd_fmapname = '// trim(atm2lnd_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('atm2lnd_fmapname = '// trim(atm2lnd_fmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='atm2lnd_smapname', value=atm2lnd_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='atm2lnd_smapname', value=atm2lnd_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('atm2lnd_smapname = '// trim(atm2lnd_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('atm2lnd_smapname = '// trim(atm2lnd_smap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='rof2lnd_fmapname', value=rof2lnd_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='rof2lnd_fmapname', value=rof2lnd_fmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('rof2lnd_fmapname = '// trim(rof2lnd_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('rof2lnd_fmapname = '// trim(rof2lnd_fmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='glc2lnd_fmapname', value=glc2lnd_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='glc2lnd_fmapname', value=glc2lnd_fmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('glc2lnd_smapname = '// trim(glc2lnd_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('glc2lnd_smapname = '// trim(glc2lnd_fmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='glc2lnd_smapname', value=glc2lnd_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='glc2lnd_smapname', value=glc2lnd_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('glc2lnd_smapname = '// trim(glc2lnd_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('glc2lnd_smapname = '// trim(glc2lnd_smap), ESMF_LOGMSG_INFO) + end if ! to ice - call NUOPC_CompAttributeGet(gcomp, name='atm2ice_fmapname', value=atm2ice_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='atm2ice_fmapname', value=atm2ice_fmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('atm2ice_fmapname = '// trim(atm2ice_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('atm2ice_fmapname = '// trim(atm2ice_fmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='atm2ice_smapname', value=atm2ice_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='atm2ice_smapname', value=atm2ice_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('atm2ice_smapname = '// trim(atm2ice_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('atm2ice_smapname = '// trim(atm2ice_smap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='atm2ice_vmapname', value=atm2ice_vmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='atm2ice_vmapname', value=atm2ice_vmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('atm2ice_vmapname = '// trim(atm2ice_vmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('atm2ice_vmapname = '// trim(atm2ice_vmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='glc2ice_rmapname', value=glc2ice_rmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='glc2ice_rmapname', value=glc2ice_rmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('glc2ice_rmapname = '// trim(glc2ice_rmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('glc2ice_rmapname = '// trim(glc2ice_rmap), ESMF_LOGMSG_INFO) + end if ! to ocn - call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_fmapname', value=atm2ocn_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_fmapname', value=atm2ocn_fmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('atm2ocn_fmapname = '// trim(atm2ocn_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('atm2ocn_fmapname = '// trim(atm2ocn_fmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_smapname', value=atm2ocn_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_smapname', value=atm2ocn_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('atm2ocn_smapname = '// trim(atm2ocn_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('atm2ocn_smapname = '// trim(atm2ocn_smap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_vmapname', value=atm2ocn_vmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_vmapname', value=atm2ocn_vmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('atm2ocn_vmapname = '// trim(atm2ocn_vmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('atm2ocn_vmapname = '// trim(atm2ocn_vmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='glc2ocn_liq_rmapname', value=glc2ocn_liq_rmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='glc2ocn_liq_rmapname', value=glc2ocn_liq_rmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('glc2ocn_liq_rmapname = '// trim(glc2ocn_liq_rmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('glc2ocn_liq_rmapname = '// trim(glc2ocn_liq_rmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='glc2ocn_ice_rmapname', value=glc2ocn_ice_rmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='glc2ocn_ice_rmapname', value=glc2ocn_ice_rmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('glc2ocn_ice_rmapname = '// trim(glc2ocn_ice_rmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('glc2ocn_ice_rmapname = '// trim(glc2ocn_ice_rmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='wav2ocn_smapname', value=wav2ocn_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='wav2ocn_smapname', value=wav2ocn_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('wav2ocn_smapname = '// trim(wav2ocn_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('wav2ocn_smapname = '// trim(wav2ocn_smap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_fmapname', value=rof2ocn_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_fmapname', value=rof2ocn_fmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('rof2ocn_fmapname = '// trim(rof2ocn_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('rof2ocn_fmapname = '// trim(rof2ocn_fmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_liq_rmapname', value=rof2ocn_liq_rmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_liq_rmapname', value=rof2ocn_liq_rmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('rof2ocn_liq_rmapname = '// trim(rof2ocn_liq_rmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('rof2ocn_liq_rmapname = '// trim(rof2ocn_liq_rmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_ice_rmapname', value=rof2ocn_ice_rmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_ice_rmapname', value=rof2ocn_ice_rmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('rof2ocn_ice_rmapname = '// trim(rof2ocn_ice_rmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('rof2ocn_ice_rmapname = '// trim(rof2ocn_ice_rmap), ESMF_LOGMSG_INFO) + end if ! to rof - call NUOPC_CompAttributeGet(gcomp, name='lnd2rof_fmapname', value=lnd2rof_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='lnd2rof_fmapname', value=lnd2rof_fmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('lnd2rof_fmapname = '// trim(lnd2rof_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('lnd2rof_fmapname = '// trim(lnd2rof_fmap), ESMF_LOGMSG_INFO) + end if ! to glc - call NUOPC_CompAttributeGet(gcomp, name='lnd2glc_fmapname', value=lnd2glc_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='lnd2glc_fmapname', value=lnd2glc_fmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('lnd2glc_fmapname = '// trim(lnd2glc_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('lnd2glc_fmapname = '// trim(lnd2glc_fmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='lnd2glc_smapname', value=lnd2glc_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='lnd2glc_smapname', value=lnd2glc_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('lnd2glc_smapname = '// trim(lnd2glc_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('lnd2glc_smapname = '// trim(lnd2glc_smap), ESMF_LOGMSG_INFO) + end if ! to wav - call NUOPC_CompAttributeGet(gcomp, name='atm2wav_smapname', value=atm2wav_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='atm2wav_smapname', value=atm2wav_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('atm2wav_smapname = '// trim(atm2wav_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('atm2wav_smapname = '// trim(atm2wav_smap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='ice2wav_smapname', value=ice2wav_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='ice2wav_smapname', value=ice2wav_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('ice2wav_smapname = '// trim(ice2wav_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('ice2wav_smapname = '// trim(ice2wav_smap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='ocn2wav_smapname', value=ocn2wav_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='ocn2wav_smapname', value=ocn2wav_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('ocn2wav_smapname = '// trim(ocn2wav_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('ocn2wav_smapname = '// trim(ocn2wav_smap), ESMF_LOGMSG_INFO) + end if !===================================================================== ! scalar information @@ -332,7 +378,6 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! --------------------------------------------------------------------- if (phase /= 'advertise') then if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'nems_orig') then - call addfld(fldListFr(compatm)%flds, 'Sa_u') call addmap(fldListFr(compatm)%flds, 'Sa_u' , compocn, mappatch, 'one', atm2ocn_vmap) @@ -348,10 +393,13 @@ subroutine esmFldsExchange(gcomp, phase, rc) call addfld(fldListFr(compatm)%flds, 'Sa_pbot') call addmap(fldListFr(compatm)%flds, 'Sa_pbot', compocn, mapbilnr, 'one', atm2ocn_smap) - do n = 1,size(iso) - call addfld(fldListFr(compatm)%flds, 'Sa_shum'//iso(n)) - call addmap(fldListFr(compatm)%flds, 'Sa_shum'//iso(n), compocn, mapbilnr, 'one', atm2ocn_smap) - end do + call addfld(fldListFr(compatm)%flds, 'Sa_shum') + call addmap(fldListFr(compatm)%flds, 'Sa_shum', compocn, mapbilnr, 'one', atm2ocn_smap) + + if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_shum_wiso', rc=rc)) then + call addfld(fldListFr(compatm)%flds, 'Sa_shum_wiso') + call addmap(fldListFr(compatm)%flds, 'Sa_shum_wiso', compocn, mapbilnr, 'one', atm2ocn_smap) + end if if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_ptem', rc=rc)) then call addfld(fldListFr(compatm)%flds, 'Sa_ptem') @@ -399,9 +447,9 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to lnd: specific humidity at the lowest model level from atm ! --------------------------------------------------------------------- - allocate(flds(11)) - flds = (/'Sa_z', 'Sa_topo', 'Sa_u', 'Sa_v', 'Sa_tbot', 'Sa_ptem', & - 'Sa_pbot', 'Sa_shum', 'Sa_shum_16O', 'Sa_shum_18O', 'Sa_shum_HDO'/) + allocate(flds(9)) + flds = (/'Sa_z', 'Sa_topo', 'Sa_u', 'Sa_v', 'Sa_tbot', & + 'Sa_ptem', 'Sa_pbot', 'Sa_shum', 'Sa_shum_wiso'/) do n = 1,size(flds) fldname = trim(flds(n)) @@ -427,34 +475,27 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to lnd: downward direct visible incident solar radiation from atm ! to lnd: downward diffuse near-infrared incident solar radiation from atm ! to lnd: downward Diffuse visible incident solar radiation from atm - ! to lnd: hydrophylic black carbon dry deposition flux from atm - ! to lnd: hydrophobic black carbon dry deposition flux from atm - ! to lnd: hydrophylic black carbon wet deposition flux from atm - ! to lnd: hydrophylic organic carbon dry deposition flux from atm - ! to lnd: hydrophobic organic carbon dry deposition flux from atm - ! to lnd: hydrophylic organic carbon wet deposition flux from atm - ! to lnd: dust wet deposition flux (size 1) from atm - ! to lnd: dust wet deposition flux (size 2) from atm - ! to lnd: dust wet deposition flux (size 3) from atm - ! to lnd: dust wet deposition flux (size 4) from atm - ! to lnd: dust dry deposition flux (size 1) from atm - ! to lnd: dust dry deposition flux (size 2) from atm - ! to lnd: dust dry deposition flux (size 3) from atm - ! to lnd: dust dry deposition flux (size 4) from atm + ! to lnd: black carbon deposition fluxes from atm + ! - hydrophylic black carbon dry deposition flux + ! - hydrophobic black carbon dry deposition flux + ! - hydrophylic black carbon wet deposition flux + ! to lnd: organic carbon deposition fluxes from atm + ! - hydrophylic organic carbon dry deposition flux + ! - hydrophobic organic carbon dry deposition flux + ! - hydrophylic organic carbon wet deposition flux + ! to lnd: dust wet deposition flux (sizes 1-4) from atm + ! to lnd: dust dry deposition flux (sizes 1-4) from atm ! to lnd: nitrogen deposition fields from atm ! --------------------------------------------------------------------- - ! TODO (mvertens, 2019-12-13): the nitrogen deposition fluxes here + ! TODO (mvertens, 2018-12-13): the nitrogen deposition fluxes here ! are not treated the same was as in cesm2.0 release + ! TODO (mvertens, 2019-03-10): add water isotopes from atm - allocate(flds(25)) - flds = (/'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', & - 'Faxa_noy' , 'Faxa_nhx'/) + allocate(flds(14)) + flds = (/'Faxa_rainc' , 'Faxa_rainl' , 'Faxa_snowc' , 'Faxa_snowl' , & + 'Faxa_lwdn' , 'Faxa_swndr' , 'Faxa_swvdr' , 'Faxa_swndf' , 'Faxa_swvdf', & + 'Faxa_bcph' , 'Faxa_ocph' , 'Faxa_dstwet' , 'Faxa_dstdry', 'Faxa_ndep' /) do n = 1,size(flds) fldname = trim(flds(n)) @@ -477,10 +518,8 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to lnd: river channel main channel water volume from rof ! to lnd: river water flux back to land due to flooding ! --------------------------------------------------------------------- - allocate(flds(12)) - flds = (/'Flrr_volr' , 'Flrr_volr_16O' , 'Flrr_volr_18O' , 'Flrr_volr_HDO' , & - 'Flrr_volrmch', 'Flrr_volrmch_16O', 'Flrr_volrmch_18O', 'Flrr_volrmch_HDO', & - 'Flrr_flood' , 'Flrr_flood_16O' , 'Flrr_flood_18O' , 'Flrr_flood_HDO' /) + allocate(flds(6)) + flds = (/'Flrr_volr', 'Flrr_volr_wiso', 'Flrr_volrmch', 'Flrr_volrmch_wiso', 'Flrr_flood', 'Flrr_flood_wiso'/) do n = 1,size(flds) fldname = trim(flds(n)) @@ -526,39 +565,29 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! fields from glc->med do NOT have elevation classes ! fields from med->lnd are BROKEN into multiple elevation classes - if (glc_nec > 0) then - if (phase == 'advertise') then - call addfld(fldListFr(compglc)%flds, 'Sg_ice_covered') ! fraction of glacier area - call addfld(fldListFr(compglc)%flds, 'Sg_topo') ! surface height of glacer - call addfld(fldListFr(compglc)%flds, 'Flgg_hflx') ! downward heat flux from glacier interior - do num = 0, glc_nec - cnum = glc_elevclass_as_string(num) - call addfld(fldListTo(complnd)%flds, 'Sg_ice_covered'//trim(cnum)) - call addfld(fldListTo(complnd)%flds, 'Sg_topo'//trim(cnum)) - call addfld(fldListTo(complnd)%flds, 'Flgg_hflx'//trim(cnum)) - end do - else - do num = 0, glc_nec - cnum = glc_elevclass_as_string(num) - if ( fldchk(is_local%wrap%FBExp(complnd) , 'Sg_ice_covered'//trim(cnum), rc=rc) .and. & - fldchk(is_local%wrap%FBExp(complnd) , 'Sg_topo'//trim(cnum) , rc=rc) .and. & - fldchk(is_local%wrap%FBExp(complnd) , 'Flgg_hflx'//trim(cnum) , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Sg_ice_covered' , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Sg_topo' , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Flgg_hflx' , rc=rc)) then - if (num == 0) then - call addmap(FldListFr(compglc)%flds, 'Sg_ice_covered' , complnd, mapconsf, 'unset' , glc2lnd_fmap) - call addmap(FldListFr(compglc)%flds, 'Sg_topo' , compglc, mapconsf, 'custom', glc2lnd_fmap) - call addmap(FldListFr(compglc)%flds, 'Flgg_hflx' , compglc, mapconsf, 'custom', glc2lnd_fmap) - end if - call addmrg(fldListTo(complnd)%flds, 'Sg_ice_covered'//trim(cnum), & - mrg_from1=compglc, mrg_fld1='Sg_ice_covered'//trim(cnum), mrg_type1='copy') - call addmrg(fldListTo(complnd)%flds, 'Sg_topo' //trim(cnum), & - mrg_from1=compglc, mrg_fld1='Sg_topo'//trim(cnum), mrg_type1='copy') - call addmrg(fldListTo(complnd)%flds, 'Flgg_hflx'//trim(cnum), & - mrg_from1=compglc, mrg_fld1='Flgg_hflx'//trim(cnum), mrg_type1='copy') - end if - end do + if (phase == 'advertise') then + call addfld(fldListFr(compglc)%flds, 'Sg_ice_covered') ! fraction of glacier area + call addfld(fldListFr(compglc)%flds, 'Sg_topo') ! surface height of glacer + call addfld(fldListFr(compglc)%flds, 'Flgg_hflx') ! downward heat flux from glacier interior + + call addfld(fldListTo(complnd)%flds, 'Sg_ice_covered_elev') + call addfld(fldListTo(complnd)%flds, 'Sg_topo_elev') + call addfld(fldListTo(complnd)%flds, 'Flgg_hflx_elev') + else + if ( fldchk(is_local%wrap%FBExp(complnd) , 'Sg_ice_covered_elev', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(complnd) , 'Sg_topo_elev' , rc=rc) .and. & + fldchk(is_local%wrap%FBExp(complnd) , 'Flgg_hflx_elev' , rc=rc) .and. & + + fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Sg_ice_covered' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Sg_topo' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Flgg_hflx' , rc=rc)) then + + ! Custom merges will be done here + call addmap(FldListFr(compglc)%flds, 'Sg_ice_covered' , complnd, mapconsf, 'unset' , glc2lnd_fmap) + call addmap(FldListFr(compglc)%flds, 'Sg_topo' , compglc, mapconsf, 'custom', glc2lnd_fmap) + call addmap(FldListFr(compglc)%flds, 'Flgg_hflx' , compglc, mapconsf, 'custom', glc2lnd_fmap) + + ! Custom merge in med_phases_prep_lnd end if end if @@ -622,8 +651,8 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to atm: merged reference specific humidity at 2 meters ! to atm: merged reference specific water isoptope humidity at 2 meters ! --------------------------------------------------------------------- - allocate(suffix(6)) - suffix = (/'tref', 'u10', 'qref', 'qref_16O', 'qref_18O', 'qref_HDO'/) + allocate(suffix(4)) + suffix = (/'tref', 'u10', 'qref', 'qref_wiso'/) do n = 1,size(suffix) if (phase == 'advertise') then @@ -675,8 +704,8 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to atm: evaporation water flux from water ! to atm: evaporation water flux from water isotopes ! --------------------------------------------------------------------- - allocate(suffix(9)) - suffix = (/'taux', 'tauy', 'lat', 'sen', 'lwup', 'evap', 'evap_16O', 'evap_18O', 'evap_HDO' /) + allocate(suffix(7)) + suffix = (/'taux', 'tauy', 'lat', 'sen', 'lwup', 'evap', 'evap_wiso'/) do n = 1,size(suffix) if (phase == 'advertise') then @@ -818,11 +847,11 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to atm: square of exch. coeff (tracers) from med aoflux ! to atm: surface fraction velocity from med aoflux ! --------------------------------------------------------------------- - allocate(suffix(3)) - suffix = (/'ssq', 're', 'ustar'/) + allocate(flds(3)) + flds = (/'So_ssq', 'So_re', 'So_ustar'/) - do n = 1,size(suffix) - fldname = 'So_'//trim(suffix(n)) + do n = 1,size(flds) + fldname = trim(flds(n)) if (phase == 'advertise') then call addfld(fldListMed_aoflux%flds , trim(fldname)) call addfld(fldListTo(compatm)%flds , trim(fldname)) @@ -835,18 +864,18 @@ subroutine esmFldsExchange(gcomp, phase, rc) end if end if end do - deallocate(suffix) + deallocate(flds) ! --------------------------------------------------------------------- ! to atm: surface fraction velocity from land ! to atm: aerodynamic resistance from land ! to atm: surface snow water equivalent from land ! --------------------------------------------------------------------- - allocate(suffix(3)) - suffix = (/'fv', 'ram1', 'snowh'/) + allocate(flds(3)) + flds = (/'Sl_fv', 'Sl_ram1', 'Sl_snowh'/) - do n = 1,size(suffix) - fldname = 'Sl_'//trim(suffix(n)) + do n = 1,size(flds) + fldname = trim(flds(n)) if (phase == 'advertise') then call addfld(fldListFr(complnd)%flds, trim(fldname)) call addfld(fldListTo(compatm)%flds, trim(fldname)) @@ -859,76 +888,55 @@ subroutine esmFldsExchange(gcomp, phase, rc) end if end if end do - deallocate(suffix) + deallocate(flds) ! --------------------------------------------------------------------- - ! to atm: dust fluxes from land + ! to atm: dust fluxes from land (4 sizes) ! --------------------------------------------------------------------- - allocate(suffix(4)) - suffix = (/'flxdst1', 'flxdst2', 'flxdst3', 'flxdst4'/) - - do n = 1,size(suffix) - fldname = 'Fall_'//trim(suffix(n)) - if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) - else - if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then - call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'lfrin', lnd2atm_fmap) - call addmrg(fldListTo(compatm)%flds, trim(fldname), & - mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='copy_with_weights', mrg_fracname1='lfrac') - end if + fldname = 'Fall_flxdst' + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then + call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'lfrin', lnd2atm_fmap) + call addmrg(fldListTo(compatm)%flds, trim(fldname), & + mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='copy_with_weights', mrg_fracname1='lfrac') end if - end do - deallocate(suffix) + end if !----------------------------------------------------------------------------- ! to atm: MEGAN emissions fluxes from land !----------------------------------------------------------------------------- + fldname = 'Fall_voc' if (phase == 'advertise') then - do num = 1, max_megan - write(cnum,'(i3.3)') num - fldname = 'Fall_voc' // cnum - call addfld(fldListFr(complnd)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) - end do + call addfld(fldListFr(complnd)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) else - do num = 1, max_megan - write(cnum,'(i3.3)') num - fldname = 'Fall_voc' // cnum - if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then - call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'one', atm2lnd_fmap) - call addmrg(fldListTo(compatm)%flds, trim(fldname), & - mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='merge', mrg_fracname1='lfrac') - end if - end do + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then + call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'one', atm2lnd_fmap) + call addmrg(fldListTo(compatm)%flds, trim(fldname), & + mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='merge', mrg_fracname1='lfrac') + end if end if !----------------------------------------------------------------------------- ! to atm: fire emissions fluxes from land !----------------------------------------------------------------------------- - ! 'wild fire emission fluxes' + fldname = 'Fall_fire' if (phase == 'advertise') then - do num = 1, max_fire - write(cnum,'(i2.2)') num - fldname = 'Fall_fire' // cnum - call addfld(fldListFr(complnd)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) - end do + call addfld(fldListFr(complnd)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) else - do num = 1, max_fire - write(cnum,'(i2.2)') num - fldname = 'Fall_fire' // cnum - if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then - call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'one', lnd2atm_fmap) - call addmrg(fldListTo(compatm)%flds, trim(fldname), & - mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='merge', mrg_fracname1='lfrac') - end if - end do + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then + call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'one', lnd2atm_fmap) + call addmrg(fldListTo(compatm)%flds, trim(fldname), & + mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='merge', mrg_fracname1='lfrac') + end if end if ! 'wild fire plume height' @@ -945,26 +953,19 @@ subroutine esmFldsExchange(gcomp, phase, rc) end if !----------------------------------------------------------------------------- - ! to atm: dry deposition from land + ! to atm: dry deposition velocities from land !----------------------------------------------------------------------------- + fldname = 'Sl_ddvel' if (phase == 'advertise') then - do num = 1, max_ddep - write(cnum,'(i2.2)') num - fldname = 'Sl_dd' // cnum - call addfld(fldListFr(complnd)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) - end do + call addfld(fldListFr(complnd)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) else - do num = 1, max_ddep - write(cnum,'(i2.2)') num - fldname = 'Sl_dd' // cnum - if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then - call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'one', lnd2atm_smap) - call addmrg(fldListTo(compatm)%flds, trim(fldname), & - mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='copy') - end if - end do + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then + call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'one', lnd2atm_smap) + call addmrg(fldListTo(compatm)%flds, trim(fldname), & + mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='copy') + end if end if !===================================================================== @@ -1126,24 +1127,26 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to ocn: per ice thickness fraction and sw penetrating into ocean from ice ! --------------------------------------------------------------------- - if (phase == 'advertise') then - if (flds_i2o_per_cat) then + if (flds_i2o_per_cat) then + if (phase == 'advertise') then ! 'fractional ice coverage wrt ocean for each thickness category ' call addfld(fldListFr(compice)%flds, 'Si_ifrac_n') + call addfld(fldListTo(compocn)%flds, 'Si_ifrac_n') + ! net shortwave radiation penetrating into ocean for each thickness category call addfld(fldListFr(compice)%flds, 'Fioi_swpen_ifrac_n') - ! 'fractional atmosphere coverage wrt ocean' + call addfld(fldListTo(compocn)%flds, 'Fioi_swpen_ifrac_n') + + ! 'fractional atmosphere coverage wrt ocean' (computed in med_phases_prep_ocn) call addfld(fldListTo(compocn)%flds, 'Sf_afrac') - ! 'net shortwave radiation times atmosphere fraction' - call addfld(fldListTo(compocn)%flds, 'Foxx_swnet_afracr') - ! 'fractional atmosphere coverage used in radiation computations wrt ocean' + ! 'fractional atmosphere coverage used in radiation computations wrt ocean' (computed in med_phases_prep_ocn) call addfld(fldListTo(compocn)%flds, 'Sf_afracr') - end if - else - if (flds_i2o_per_cat) then - call addmap(fldListFr(compice)%flds, 'Si_ifrac_n', compocn, mapfcopy, 'unset', 'unset') + ! 'net shortwave radiation times atmosphere fraction' (computed in med_phases_prep_ocn) + call addfld(fldListTo(compocn)%flds, 'Foxx_swnet_afracr') + else + call addmap(fldListFr(compice)%flds, 'Si_ifrac_n' , compocn, mapfcopy, 'unset', 'unset') call addmap(fldListFr(compice)%flds, 'Fioi_swpen_ifrac_n', compocn, mapfcopy, 'unset', 'unset') - ! TODO (mvertens, 2018-12-21): add mapping and merging + ! Note that 'Sf_afrac, 'Sf_afracr' and 'Foxx_swnet_afracr' will have explicit merging in med_phases_prep_ocn end if end if @@ -1151,20 +1154,29 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to ocn: precipitation rate water equivalent from atm ! to ocn: snow rate water equivalent from atm ! --------------------------------------------------------------------- + if (phase == 'advertise') then - do n = 1,size(iso) - call addfld(fldListFr(compatm)%flds, 'Faxa_rainc'//iso(n)) - call addfld(fldListFr(compatm)%flds, 'Faxa_rainl'//iso(n)) - call addfld(fldListFr(compatm)%flds, 'Faxa_rain' //iso(n)) - call addfld(fldListTo(compocn)%flds, 'Faxa_rain' //iso(n)) - - call addfld(fldListFr(compatm)%flds, 'Faxa_snowc'//iso(n)) - call addfld(fldListFr(compatm)%flds, 'Faxa_snowl'//iso(n)) - call addfld(fldListFr(compatm)%flds, 'Faxa_snow' //iso(n)) - call addfld(fldListTo(compocn)%flds, 'Faxa_snow' //iso(n)) - end do + call addfld(fldListFr(compatm)%flds, 'Faxa_rainc') + call addfld(fldListFr(compatm)%flds, 'Faxa_rainl') + call addfld(fldListFr(compatm)%flds, 'Faxa_rain' ) + call addfld(fldListTo(compocn)%flds, 'Faxa_rain' ) + + call addfld(fldListFr(compatm)%flds, 'Faxa_rainc_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_rainl_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_rain_wiso' ) + call addfld(fldListTo(compocn)%flds, 'Faxa_rain_wiso' ) + + call addfld(fldListFr(compatm)%flds, 'Faxa_snowc') + call addfld(fldListFr(compatm)%flds, 'Faxa_snowl') + call addfld(fldListFr(compatm)%flds, 'Faxa_snow' ) + call addfld(fldListTo(compocn)%flds, 'Faxa_snow' ) + + call addfld(fldListFr(compatm)%flds, 'Faxa_snowc_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_snowl_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_snow_wiso' ) + call addfld(fldListTo(compocn)%flds, 'Faxa_snow_wiso' ) else - do n = 1,size(iso) + do n = 1,2 ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization ! which by default is not actually used if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl'//iso(n), rc=rc) .and. & @@ -1247,39 +1259,48 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to ocn: surface latent heat flux and evaporation water flux ! --------------------------------------------------------------------- - do n = 1,size(iso) - if (phase == 'advertise') then - call addfld(fldListMed_aoflux%flds , 'Faxa_lat' //iso(n)) - call addfld(fldListMed_aoflux%flds , 'Faox_lat' //iso(n)) - call addfld(fldListMed_aoflux%flds , 'Faox_evap'//iso(n)) - call addfld(fldListTo(compocn)%flds, 'Foxx_lat' //iso(n)) - call addfld(fldListTo(compocn)%flds, 'Foxx_evap'//iso(n)) - else - ! CESM - if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_lat'//iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_lat'//iso(n), rc=rc)) then - call addmrg(fldListTo(compocn)%flds, 'Foxx_lat'//iso(n), & - mrg_from1=compmed, mrg_fld1='Faox_lat'//iso(n), mrg_type1='merge', mrg_fracname1='ofrac') - end if - if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap', rc=rc) .and. & - fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_evap', rc=rc)) then - call addmrg(fldListTo(compocn)%flds, 'Foxx_evap', & - mrg_from1=compmed, mrg_fld1='Faox_evap', mrg_type1='merge', mrg_fracname1='ofrac') - end if - ! NEMS orig - if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_lat' , rc=rc) .and. & - fldchk(is_local%wrap%FBMed_aoflux_o , 'Foax_evap' , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_lat' , rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_lat', compocn, mapconsf, 'one', atm2ocn_fmap) - end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_lat' ) + call addfld(fldListMed_aoflux%flds , 'Faox_lat' ) + call addfld(fldListMed_aoflux%flds , 'Faox_evap') + call addfld(fldListTo(compocn)%flds, 'Foxx_lat' ) + call addfld(fldListTo(compocn)%flds, 'Foxx_evap') + else + ! CESM + if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_lat', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_lat', rc=rc)) then + call addmrg(fldListTo(compocn)%flds, 'Foxx_lat', & + mrg_from1=compmed, mrg_fld1='Faox_lat', mrg_type1='merge', mrg_fracname1='ofrac') + end if + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_evap', rc=rc)) then + call addmrg(fldListTo(compocn)%flds, 'Foxx_evap', & + mrg_from1=compmed, mrg_fld1='Faox_evap', mrg_type1='merge', mrg_fracname1='ofrac') + end if + ! NEMS orig + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_lat' , rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Foax_evap' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_lat' , rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_lat', compocn, mapconsf, 'one', atm2ocn_fmap) + end if + + ! NEMS-frac and NEMS-orig + ! Foxx_evap is passed to mom6 but but not the latent heat flux and mom6 then computes + ! the latent heat flux from the imported evaporative flux. However, the evap passed to mom6 + ! in med_phases_prep_ocn is in fact derived from the latent heat flux obtained from the atm (fv3). + ! TODO (mvertens, 2019-10-01): Can we unify this and have MOM6 use latent heat flux? + end if - ! NEMS-frac and NEMS-orig - ! Foxx_evap is passed to mom6 but but not the latent heat flux and mom6 then computes - ! the latent heat flux from the imported evaporative flux. However, the evap passed to mom6 - ! in med_phases_prep_ocn is in fact derived from the latent heat flux obtained from the atm (fv3). - ! TODO (mvertens, 2019-10-01): Can we unify this and have MOM6 use latent heat flux? + if (phase == 'advertise') then + call addfld(fldListMed_aoflux%flds , 'Faox_lat_wiso' ) + call addfld(fldListTo(compocn)%flds, 'Foxx_lat_wiso' ) + else + if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_lat_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_lat_wiso', rc=rc)) then + call addmrg(fldListTo(compocn)%flds, 'Foxx_lat_wiso', & + mrg_from1=compmed, mrg_fld1='Faox_lat_wiso', mrg_type1='merge', mrg_fracname1='ofrac') end if - end do + end if ! --------------------------------------------------------------------- ! to ocn: wind speed squared at 10 meters from med @@ -1316,29 +1337,23 @@ subroutine esmFldsExchange(gcomp, phase, rc) end if ! --------------------------------------------------------------------- - ! to ocn: hydrophylic black carbon dry deposition flux from atm - ! to ocn: hydrophobic black carbon dry deposition flux from atm - ! to ocn: hydrophylic black carbon wet deposition flux from atm - ! to ocn: hydrophylic organic carbon dry deposition flux from atm - ! to ocn: hydrophobic organic carbon dry deposition flux from atm - ! to ocn: hydrophylic organic carbon wet deposition flux to ice from atm - ! to ocn: dust wet deposition flux (size 1) from atm - ! to ocn: dust wet deposition flux (size 2) from atm - ! to ocn: dust wet deposition flux (size 3) from atm - ! to ocn: dust wet deposition flux (size 4) from atm - ! to ocn: dust dry deposition flux (size 1) from atm - ! to ocn: dust dry deposition flux (size 2) from atm - ! to ocn: dust dry deposition flux (size 3) from atm - ! to ocn: dust dry deposition flux (size 4) from atm - ! --------------------------------------------------------------------- - allocate(suffix(14)) - suffix = (/'bcphidry', 'bcphodry', 'bcphiwet', & - 'ocphidry', 'ocphodry', 'ocphiwet', & - 'dstwet1' , 'dstwet2' , 'dstwet3', 'dstwet4', & - 'dstdry1' , 'dstdry2' , 'dstdry3', 'dstdry4' /) + ! to ocn: black carbon deposition fluxes from atm + ! - hydrophylic black carbon dry deposition flux + ! - hydrophobic black carbon dry deposition flux + ! - hydrophylic black carbon wet deposition flux + ! to ocn: organic carbon deposition fluxes from atm + ! - hydrophylic organic carbon dry deposition flux + ! - hydrophobic organic carbon dry deposition flux + ! - hydrophylic organic carbon wet deposition flux + ! to ocn: dust wet deposition flux (sizes 1-4) from atm + ! to ocn: dust dry deposition flux (sizes 1-4) from atm + ! to ocn: nitrogen deposition fields (2) from atm + ! --------------------------------------------------------------------- + allocate(flds(5)) + flds = (/'Faxa_bcph', 'Faxa_ocph', 'Faxa_dstwet' , 'Faxa_dstdry', 'Faxa_ndep' /) - do n = 1,size(suffix) - fldname = 'Faxa_'//trim(suffix(n)) + do n = 1,size(flds) + fldname = trim(flds(n)) if (phase == 'advertise') then call addfld(fldListFr(compatm)%flds, trim(fldname)) call addfld(fldListTo(compocn)%flds, trim(fldname)) @@ -1351,30 +1366,7 @@ subroutine esmFldsExchange(gcomp, phase, rc) end if end if end do - deallocate(suffix) - - !----------------------------------------------------------------------------- - ! to ocn: nitrogen deposition fields from atm - !----------------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_noy') - call addfld(fldListFr(compatm)%flds, 'Faxa_nhx') - call addfld(fldListTo(compocn)%flds, 'Faxa_noy') - call addfld(fldListTo(compocn)%flds, 'Faxa_nhx') - else - if ( fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_noy', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_noy', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_noy', compocn, mapbilnr, 'one', atm2ocn_smap) - call addmrg(fldListTo(compocn)%flds, 'Faxa_noy', & - mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy_with_weights', mrg_fracname1='ofrac') - end if - if ( fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_nhx', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_nhx', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_nhx', compocn, mapbilnr, 'one', atm2ocn_smap) - call addmrg(fldListTo(compocn)%flds, 'Faxa_nhx', & - mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy_with_weights', mrg_fracname1='ofrac') - end if - end if + deallocate(flds) ! --------------------------------------------------------------------- ! to ocn: merge zonal surface stress from ice and (atm or med) @@ -1478,14 +1470,12 @@ subroutine esmFldsExchange(gcomp, phase, rc) end do else do n = 1,size(iso) - ! liquid runoff from both rof and glc to ocn - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_rofl' //iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl' //iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood'//iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compglc, compglc), 'Fogg_rofl' //iso(n), rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Flrr_flood'//iso(n), compocn, mapfiler, 'none', rof2ocn_fmap) - call addmap(fldListFr(comprof)%flds, 'Forr_rofl' //iso(n), compocn, mapfiler, 'none', rof2ocn_liq_rmap) - call addmap(fldListFr(compglc)%flds, 'Fogg_rofl' //iso(n), compocn, mapfiler, 'one' , glc2ocn_liq_rmap) + ! from both rof and glc to con + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_rofl'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compglc, compglc), 'Fogg_rofl'//iso(n), rc=rc)) then + call addmap(fldListFr(comprof)%flds, 'Forr_rofl'//iso(n), compocn, mapconsf, 'none', rof2ocn_liq_rmap) + call addmap(fldListFr(compglc)%flds, 'Fogg_rofl'//iso(n), compocn, mapconsf, 'one' , glc2ocn_liq_rmap) call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl'//iso(n), & mrg_from1=comprof, mrg_fld1='Forr_rofl:Flrr_flood', mrg_type1='sum', & mrg_from2=compglc, mrg_fld2='Fogg_rofl'//iso(n) , mrg_type2='sum') @@ -1494,22 +1484,22 @@ subroutine esmFldsExchange(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_rofl' //iso(n), rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl' //iso(n), rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood'//iso(n), rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Flrr_flood'//iso(n), compocn, mapfiler, 'none', rof2ocn_fmap) - call addmap(fldListFr(comprof)%flds, 'Forr_rofl' //iso(n), compocn, mapfiler, 'none', rof2ocn_liq_rmap) + call addmap(fldListFr(comprof)%flds, 'Flrr_flood'//iso(n), compocn, mapconsf, 'none', rof2ocn_fmap) + call addmap(fldListFr(comprof)%flds, 'Forr_rofl' //iso(n), compocn, mapconsf, 'none', rof2ocn_liq_rmap) call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl' //iso(n), & mrg_from1=comprof, mrg_fld1='Forr_rofl:Flrr_flood', mrg_type1='sum') ! liquid from just rof to ocn else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_rofl'//iso(n), rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl'//iso(n), rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Forr_rofl'//iso(n), compocn, mapfiler, 'none', rof2ocn_liq_rmap) + call addmap(fldListFr(comprof)%flds, 'Forr_rofl'//iso(n), compocn, mapconsf, 'none', rof2ocn_liq_rmap) call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl'//iso(n), & - mrg_from1=comprof, mrg_fld1='Forr_rofl:Flrr_flood', mrg_type1='sum') + mrg_from1=comprof, mrg_fld1='Forr_rofl', mrg_type1='copy') ! liquid runoff from just glc to ocn else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_rofl'//iso(n), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compglc, compglc), 'Fogg_rofl'//iso(n), rc=rc)) then - call addmap(fldListFr(compglc)%flds, 'Fogg_rofl'//iso(n), compocn, mapfiler, 'one', glc2ocn_liq_rmap) + call addmap(fldListFr(compglc)%flds, 'Fogg_rofl'//iso(n), compocn, mapconsf, 'one', glc2ocn_liq_rmap) call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl'//iso(n), & mrg_from1=compglc, mrg_fld1='Fogg_rofl'//iso(n), mrg_type1='copy') end if @@ -1518,8 +1508,8 @@ subroutine esmFldsExchange(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_rofi'//iso(n), rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi'//iso(n), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compglc, compglc), 'Fogg_rofi'//iso(n), rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n), compocn, mapfiler, 'none', rof2ocn_ice_rmap) - call addmap(fldListFr(compglc)%flds, 'Fogg_rofi'//iso(n), compocn, mapfiler, 'one' , glc2ocn_ice_rmap) + call addmap(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n), compocn, mapconsf, 'none', rof2ocn_ice_rmap) + call addmap(fldListFr(compglc)%flds, 'Fogg_rofi'//iso(n), compocn, mapconsf, 'one' , glc2ocn_ice_rmap) call addmrg(fldListTo(compocn)%flds, 'Foxx_rofi'//iso(n), & mrg_from1=comprof, mrg_fld1='Forr_rofi'//iso(n), mrg_type1='sum', & mrg_from2=compglc, mrg_fld2='Fogg_rofi'//iso(n), mrg_type2='sum') @@ -1527,14 +1517,14 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! ice runoff from just rof to ocn else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_rofi'//iso(n), rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi'//iso(n), rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n), compocn, mapfiler, 'none', rof2ocn_ice_rmap) + call addmap(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n), compocn, mapconsf, 'none', rof2ocn_ice_rmap) call addmrg(fldListTo(compocn)%flds, 'Foxx_rofi'//iso(n), & mrg_from1=comprof, mrg_fld1='Forr_rofi', mrg_type1='copy') ! ice runoff from just glc to ocn else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_rofi'//iso(n), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compglc, compglc), 'Fogg_rofi'//iso(n), rc=rc)) then - call addmap(fldListFr(compglc)%flds, 'Fogg_rofi'//iso(n), compocn, mapfiler, 'one', glc2ocn_ice_rmap) + call addmap(fldListFr(compglc)%flds, 'Fogg_rofi'//iso(n), compocn, mapconsf, 'one', glc2ocn_ice_rmap) call addmrg(fldListTo(compocn)%flds, 'Foxx_rofi'//iso(n), & mrg_from1=compglc, mrg_fld1='Fogg_rofi'//iso(n), mrg_type1='copy') end if @@ -1566,7 +1556,6 @@ subroutine esmFldsExchange(gcomp, phase, rc) end do deallocate(flds) - !===================================================================== ! FIELDS TO ICE (compice) !===================================================================== @@ -1592,12 +1581,9 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to ice: dust dry deposition flux (size 3) from atm ! to ice: dust dry deposition flux (size 4) from atm ! --------------------------------------------------------------------- - allocate(flds(19)) + allocate(flds(9)) flds = (/'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'/) + 'Faxa_bcph' , 'Faxa_ocph' , 'Faxa_dstwet' , 'Faxa_dstdry' /) do n = 1,size(flds) fldname = trim(flds(n)) @@ -1619,57 +1605,83 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to ice: convective and large scale precipitation rate water equivalent from atm ! to ice: rain and snow rate from atm ! --------------------------------------------------------------------- - do n = 1,size(iso) - if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_rainc'//iso(n)) - call addfld(fldListFr(compatm)%flds, 'Faxa_rainl'//iso(n)) - call addfld(fldListFr(compatm)%flds, 'Faxa_rain' //iso(n)) - call addfld(fldListTo(compice)%flds, 'Faxa_rain' //iso(n)) - - call addfld(fldListFr(compatm)%flds, 'Faxa_snowc'//iso(n)) - call addfld(fldListFr(compatm)%flds, 'Faxa_snowl'//iso(n)) - call addfld(fldListFr(compatm)%flds, 'Faxa_snow' //iso(n)) - call addfld(fldListTo(compice)%flds, 'Faxa_snow' //iso(n)) - else - if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain' //iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl'//iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc'//iso(n), rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rainc'//iso(n), compice, mapconsf, 'one', atm2ice_fmap) - call addmap(fldListFr(compatm)%flds, 'Faxa_rainl'//iso(n), compice, mapconsf, 'one', atm2ice_fmap) - if (iso(n) == ' ') then - fldname = 'Faxa_rainc:Faxa_rainl' - else - fldname = trim('Faxa_rainc'//iso(n))//':'//trim('Faxa_rainl'//iso(n)) - end if - call addmrg(fldListTo(compice)%flds, 'Faxa_rain' //iso(n) , & - mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='sum') - else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain'//iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain'//iso(n), rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rain'//iso(n), compice, mapconsf, 'one', atm2ice_fmap) - call addmrg(fldListTo(compice)%flds, 'Faxa_rain'//iso(n), & - mrg_from1=compatm, mrg_fld1='Faxa_rain'//iso(n), mrg_type1='copy') - end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_rainc') + call addfld(fldListFr(compatm)%flds, 'Faxa_rainl') + call addfld(fldListFr(compatm)%flds, 'Faxa_rain' ) + call addfld(fldListTo(compice)%flds, 'Faxa_rain' ) + + call addfld(fldListFr(compatm)%flds, 'Faxa_rainc_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_rainl_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_rain_wiso' ) + call addfld(fldListTo(compice)%flds, 'Faxa_rain_wiso' ) + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_rainc', compice, mapconsf, 'one', atm2ice_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_rainl', compice, mapconsf, 'one', atm2ice_fmap) + call addmrg(fldListTo(compice)%flds, 'Faxa_rain' , & + mrg_from1=compatm, mrg_fld1='Faxa_rainc:Faxa_rainl', mrg_type1='sum') + else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_rain', compice, mapconsf, 'one', atm2ice_fmap) + call addmrg(fldListTo(compice)%flds, 'Faxa_rain', & + mrg_from1=compatm, mrg_fld1='Faxa_rain', mrg_type1='copy') + end if + if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain_wiso' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc_wiso', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_rainc_wiso', compice, mapconsf, 'one', atm2ice_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_rainl_wiso', compice, mapconsf, 'one', atm2ice_fmap) + call addmrg(fldListTo(compice)%flds, 'Faxa_rain_wiso' , & + mrg_from1=compatm, mrg_fld1='Faxa_rainc_wiso:Faxa_rainl_wiso', mrg_type1='sum') + else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain_wiso', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_rain_wiso', compice, mapconsf, 'one', atm2ice_fmap) + call addmrg(fldListTo(compice)%flds, 'Faxa_rain_wiso', & + mrg_from1=compatm, mrg_fld1='Faxa_rain_wiso', mrg_type1='copy') + end if + end if - if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow' //iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl'//iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc'//iso(n), rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snowc'//iso(n), compice, mapconsf, 'one', atm2ice_fmap) - call addmap(fldListFr(compatm)%flds, 'Faxa_snowl'//iso(n), compice, mapconsf, 'one', atm2ice_fmap) - if (iso(n) == ' ') then - fldname = 'Faxa_snowc:Faxa_snowl' - else - fldname = trim('Faxa_snowc'//iso(n))//':'//trim('Faxa_snowl'//iso(n)) - end if - call addmrg(fldListTo(compice)%flds, 'Faxa_snow' //iso(n) , & - mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='sum') - else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow'//iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow'//iso(n), rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snow'//iso(n), compice, mapconsf, 'one', atm2ice_fmap) - call addmrg(fldListTo(compice)%flds, 'Faxa_snow'//iso(n), & - mrg_from1=compatm, mrg_fld1='Faxa_snow'//iso(n), mrg_type1='copy') - end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_snowc') + call addfld(fldListFr(compatm)%flds, 'Faxa_snowl') + call addfld(fldListFr(compatm)%flds, 'Faxa_snow' ) + call addfld(fldListTo(compice)%flds, 'Faxa_snow' ) + + call addfld(fldListFr(compatm)%flds, 'Faxa_snowc_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_snowl_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_snow_wiso' ) + call addfld(fldListTo(compice)%flds, 'Faxa_snow_wiso' ) + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_snowc', compice, mapconsf, 'one', atm2ice_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_snowl', compice, mapconsf, 'one', atm2ice_fmap) + call addmrg(fldListTo(compice)%flds, 'Faxa_snow' , & + mrg_from1=compatm, mrg_fld1='Faxa_snowc:Faxa_snowl', mrg_type1='sum') + else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_snow', compice, mapconsf, 'one', atm2ice_fmap) + call addmrg(fldListTo(compice)%flds, 'Faxa_snow', & + mrg_from1=compatm, mrg_fld1='Faxa_snow', mrg_type1='copy') end if - end do + if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc_wiso', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_snowc_wiso', compice, mapconsf, 'one', atm2ice_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_snowl_wiso', compice, mapconsf, 'one', atm2ice_fmap) + call addmrg(fldListTo(compice)%flds, 'Faxa_snow_wiso' , & + mrg_from1=compatm, mrg_fld1='Faxa_snowc_wiso:Faxa_snowl_wiso', mrg_type1='sum') + else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow_wiso', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_snow_wiso', compice, mapconsf, 'one', atm2ice_fmap) + call addmrg(fldListTo(compice)%flds, 'Faxa_snow_wiso', & + mrg_from1=compatm, mrg_fld1='Faxa_snow_wiso', mrg_type1='copy') + end if + end if ! --------------------------------------------------------------------- ! to ice: height at the lowest model level from atm @@ -1682,9 +1694,8 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to ice: specific humidity at the lowest model level from atm ! to ice: specific humidity for water isotopes at the lowest model level from atm ! --------------------------------------------------------------------- - allocate(flds(11)) - flds = (/'Sa_z', 'Sa_pbot', 'Sa_tbot', 'Sa_ptem', 'Sa_dens', 'Sa_u', 'Sa_v', & - 'Sa_shum', 'Sa_shum_16O', 'Sa_shum_18O', 'Sa_shum_HDO'/) + allocate(flds(9)) + flds = (/'Sa_z', 'Sa_pbot', 'Sa_tbot', 'Sa_ptem', 'Sa_dens', 'Sa_u', 'Sa_v', 'Sa_shum', 'Sa_shum_wiso'/) do n = 1,size(flds) fldname = trim(flds(n)) @@ -1747,6 +1758,20 @@ subroutine esmFldsExchange(gcomp, phase, rc) end if end if + !----------------------------- + ! to ice: Ratio of ocean surface level abund. H2_16O/H2O/Rstd from ocean + !----------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compocn)%flds, 'So_roce_wiso') + call addfld(fldListTo(compice)%flds, 'So_roce_wiso') + else + if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_roce_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compice) , 'So_roce_wiso', rc=rc)) then + call addmap(fldListFr(compocn)%flds, 'So_roce_wiso', compice, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compice)%flds, 'So_roce_wiso', mrg_from1=compocn, mrg_fld1='So_roce_wiso', mrg_type1='copy') + end if + end if + ! --------------------------------------------------------------------- ! to ice: frozen runoff from rof and glc ! --------------------------------------------------------------------- @@ -1760,8 +1785,8 @@ subroutine esmFldsExchange(gcomp, phase, rc) fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi'//iso(n), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compglc, compglc), 'Figg_rofi'//iso(n), rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n), compice, mapfiler, 'none', rof2ocn_ice_rmap) - call addmap(fldListFr(compglc)%flds, 'Figg_rofi'//iso(n), compice, mapfiler, 'one' , glc2ice_rmap) + call addmap(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n), compice, mapconsf, 'none', rof2ocn_ice_rmap) + call addmap(fldListFr(compglc)%flds, 'Figg_rofi'//iso(n), compice, mapconsf, 'one' , glc2ice_rmap) call addmrg(fldListTo(compice)%flds, 'Fixx_rofi'//iso(n), & mrg_from1=comprof, mrg_fld1='Firr_rofi'//iso(n), mrg_type1='sum', & mrg_from2=compglc, mrg_fld2='Figg_rofi'//iso(n), mrg_type2='sum') @@ -1769,7 +1794,7 @@ subroutine esmFldsExchange(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compice) , 'Fixx_rofi'//iso(n), rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi'//iso(n), rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n), compice, mapfiler, 'none', rof2ocn_ice_rmap) + call addmap(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n), compice, mapconsf, 'none', rof2ocn_ice_rmap) call addmrg(fldListTo(compice)%flds, 'Fixx_rofi'//iso(n), & mrg_from1=comprof, mrg_fld1='Firr_rofi'//iso(n), mrg_type1='sum') end if @@ -1784,31 +1809,48 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to wav: fractional ice coverage wrt ocean from ice !---------------------------------------------------------- if (phase == 'advertise') then - ! the following is computed in med_phases_prep_wav call addfld(fldListFr(compice)%flds, 'Si_ifrac') call addfld(fldListTo(compwav)%flds, 'Si_ifrac') + else + if ( fldchk(is_local%wrap%FBexp(compwav) , 'Si_ifrac', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_ifrac', rc=rc)) then + ! By default will be using a custom map - but if one is not available, use a generated bilinear instead + call addmap(fldListFr(compice)%flds, 'Si_ifrac', compwav, mapbilnr, 'one', ice2wav_smap) + call addmrg(fldListTo(compwav)%flds, 'Si_ifrac', & + mrg_from1=compice, mrg_fld1='Si_ifrac', mrg_type1='copy') + end if end if ! --------------------------------------------------------------------- ! to wav: ocean boundary layer depth from ocn + ! to wav: ocean currents from ocn + ! to wav: ocean surface temperature from ocn ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld(fldListFr(compocn)%flds, 'So_bldepth') - call addfld(fldListTo(compwav)%flds, 'So_bldepth') - else - if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_bldepth', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compwav) , 'So_bldepth', rc=rc)) then - call addmap(fldListFr(compocn)%flds, 'So_bldepth', compwav, mapbilnr, 'one', ocn2wav_smap) - call addmrg(fldListTo(compwav)%flds, 'So_bldepth', mrg_from1=compocn, mrg_fld1='So_bldepth', mrg_type1='copy') + allocate(flds(4)) + flds = (/'So_t', 'So_u', 'So_v', 'So_bldepth'/) + + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compocn)%flds, trim(fldname)) + call addfld(fldListTo(compwav)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBImp(compocn, compocn), trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compwav) , trim(fldname), rc=rc)) then + ! By default will be using a custom map - but if one is not available, use a generated bilinear instead + call addmap(fldListFr(compocn)%flds, trim(fldname), compwav, mapbilnr, 'one', ocn2wav_smap) + call addmrg(fldListTo(compwav)%flds, trim(fldname), mrg_from1=compocn, mrg_fld1=trim(fldname), mrg_type1='copy') + end if end if - end if + end do + deallocate(flds) ! --------------------------------------------------------------------- ! to wav: zonal wind at the lowest model level from atm ! to wav: meridional wind at the lowest model level from atm ! --------------------------------------------------------------------- - allocate(flds(2)) - flds = (/'Sa_u', 'Sa_v'/) + allocate(flds(3)) + flds = (/'Sa_u', 'Sa_v', 'Sa_tbot'/) do n = 1,size(flds) fldname = trim(flds(n)) @@ -1838,13 +1880,10 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to rof: irrigation flux from land (withdrawal from rivers) ! --------------------------------------------------------------------- ! TODO (mvertens, 2019-01-13): the following isotopes have not yet been defined in the NUOPC field dict - ! allocate(flds(30)) - ! flds = (/'Flrl_rofsur', 'Flrl_rofsur_16O', 'Flrl_rofsur_18O', 'Flrl_rofsur_HDO', & - ! 'Flrl_rofgwl', 'Flrl_rofgwl_16O', 'Flrl_rofgwl_18O', 'Flrl_rofgwl_HDO', & - ! 'Flrl_rofsub', 'Flrl_rofsub_16O', 'Flrl_rofsub_18O', 'Flrl_rofsub_HDO', & - ! 'Flrl_rofdto', 'Flrl_rofdto_16O', 'Flrl_rofdto_18O', 'Flrl_rofdto_HDO', & - ! 'Flrl_rofi' , 'Flrl_rofi_16O' , 'Flrl_rofi_18O' , 'Flrl_rofi_HDO' , & - ! 'Flrl_irrig' , 'Flrl_irrig_16O' , 'Flrl_irrig_18O' , 'Flrl_irrig_HDO' /) + ! allocate(flds(12)) + ! flds = (/'Flrl_rofsur', 'Flrl_rofsur_wiso', 'Flrl_rofgwl', 'Flrl_rofgwl_wiso', & + ! 'Flrl_rofsub', 'Flrl_rofsub_wiso', 'Flrl_rofdto', 'Flrl_rofdto_wiso', & + ! 'Flrl_rofi' , 'Flrl_rofi_wiso' , 'Flrl_irrig' , 'Flrl_irrig_wiso' /) allocate(flds(6)) flds = (/'Flrl_rofsur', 'Flrl_rofgwl', 'Flrl_rofsub', 'Flrl_rofdto', 'Flrl_rofi', 'Flrl_irrig'/) @@ -1857,7 +1896,7 @@ subroutine esmFldsExchange(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , trim(fldname), rc=rc)) then - call addmap(fldListFr(complnd)%flds, trim(fldname), comprof, mapconsd, 'lfrin', lnd2rof_fmap) + call addmap(fldListFr(complnd)%flds, trim(fldname), comprof, mapconsd, 'lfrac', lnd2rof_fmap) call addmrg(fldListTo(comprof)%flds, trim(fldname), & mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='copy_with_weights', mrg_fracname1='lfrac') end if @@ -1872,7 +1911,6 @@ subroutine esmFldsExchange(gcomp, phase, rc) !----------------------------- ! to glc: from land !----------------------------- - ! - fields sent from lnd->med ARE in multiple elevation classes ! - fields sent from med->glc do NOT have elevation classes @@ -1880,32 +1918,26 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! Note that, if glc_nec = 0, then we don't create any coupling fields (not even the bare land (0) fldindex) ! Note : Sl_topo is sent from lnd -> med, but is NOT sent to glc (only used for the remapping in the mediator) - if (glc_nec > 0) then - if (phase == 'advertise') then - do num = 0, glc_nec - cnum = glc_elevclass_as_string(num) - call addfld(fldListFr(complnd)%flds, 'Flgl_qice'//trim(cnum)) ! glacier ice flux' - call addfld(fldListFr(complnd)%flds, 'Sl_tsrf' //trim(cnum)) ! surface temperature of glacier' - call addfld(fldListFr(complnd)%flds, 'Sl_topo' //trim(cnum)) ! surface height of glacier - end do - call addfld(fldListTo(compglc)%flds, 'Flgl_qice') - call addfld(fldListTo(compglc)%flds, 'Sl_tsrf') - call addfld(fldListTo(compglc)%flds, 'Sl_topo') - else - if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flgl_qice'//trim(cnum), rc=rc) .and. & - fldchk(is_local%wrap%FBExp(complnd) , 'Sl_tsrf'//trim(cnum) , rc=rc) .and. & - fldchk(is_local%wrap%FBExp(complnd) , 'Sl_topo'//trim(cnum) , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Sg_ice_covered' , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Sg_topo' , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Flgg_hflx' , rc=rc)) then - - do num = 0, glc_nec - cnum = glc_elevclass_as_string(num) - call addmap(FldListFr(complnd)%flds, 'Flgl_qice'//trim(cnum), compglc, mapconsf, 'none', lnd2glc_fmap) - call addmap(FldListFr(complnd)%flds, 'Sl_tsrf'//trim(cnum) , compglc, mapbilnr, 'none', lnd2glc_smap) - call addmap(FldListFr(complnd)%flds, 'Sl_topo'//trim(cnum) , compglc, mapbilnr, 'none', lnd2glc_smap) - end do - end if + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Sl_tsrf_elev') ! surface temperature of glacier (1->glc_nec+1) + call addfld(fldListFr(complnd)%flds, 'Sl_topo_elev') ! surface heights of glacier (1->glc_nec+1) + call addfld(fldListFr(complnd)%flds, 'Flgl_qice_elev') ! glacier ice flux (1->glc_nec+1) + + call addfld(fldListTo(compglc)%flds, 'Sl_tsrf') + call addfld(fldListTo(compglc)%flds, 'Sl_topo') + call addfld(fldListTo(compglc)%flds, 'Flgl_qice') + else + if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Flgl_qice_elev', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Sl_tsrf_elev' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Sl_topo_elev' , rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compglc) , 'Sg_ice_covered', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compglc) , 'Sg_topo' , rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compglc) , 'Flgg_hflx' , rc=rc)) then + + ! custom merging will be done here + call addmap(FldListFr(complnd)%flds, 'Flgl_qice_elev', compglc, mapconsf, 'none', lnd2glc_fmap) + call addmap(FldListFr(complnd)%flds, 'Sl_tsrf_elev' , compglc, mapbilnr, 'none', lnd2glc_smap) + call addmap(FldListFr(complnd)%flds, 'Sl_topo_elev' , compglc, mapbilnr, 'none', lnd2glc_smap) end if end if @@ -1916,17 +1948,17 @@ subroutine esmFldsExchange(gcomp, phase, rc) call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2a - call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO) call NUOPC_CompAttributeGet(gcomp, name='flds_co2b', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2b - call ESMF_LogWrite('flds_co2b = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite('flds_co2b = '// trim(cvalue), ESMF_LOGMSG_INFO) call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2c - call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO) if (flds_co2a) then ! --------------------------------------------------------------------- @@ -2061,16 +2093,6 @@ subroutine esmFldsExchange(gcomp, phase, rc) end if endif - !----------------------------- - ! water isotope fields - TODO: add these to dictionary first - !----------------------------- - ! 'Ratio of ocean surface level abund. H2_16O/H2O/Rstd' - ! call fld_add(flds_o2x, "So_roce_16O") - ! call fld_add(flds_x2i, "So_roce_16O") - ! 'Ratio of ocean surface level abund. HDO/H2O/Rstd' - ! call fld_add(flds_o2x, "So_roce_HDO") - ! call fld_add(flds_x2i, "So_roce_HDO") - !----------------------------------------------------------------------------- ! CARMA fields (volumetric soil water) !----------------------------------------------------------------------------- diff --git a/src/drivers/nuopc/cime_flds/fd.yaml b/src/drivers/nuopc/cime_flds/fd.yaml index 49ab5eaaaccb..3936273fcdaf 100644 --- a/src/drivers/nuopc/cime_flds/fd.yaml +++ b/src/drivers/nuopc/cime_flds/fd.yaml @@ -15,577 +15,114 @@ description: mediator export atm/ocn evaporation water flux # - - standard_name: Faox_lat - alias: mean_laten_heat_flx_atm_into_ocn - canonical_units: W m-2 - description: mediator export - atm/ocn surface latent heat flux - # - - standard_name: Faox_sen - alias: mean_sensi_heat_flx_atm_into_ocn - canonical_units: W m-2 - description: mediator export - atm/ocn surface sensible heat flux - # - - standard_name: Faox_lwup - alias: mean_up_lw_flx_ocn - canonical_units: W m-2 - description: mediator export - long wave radiation flux over the ocean - # - - standard_name: Faox_taux - alias: stress_on_air_ocn_zonal - canonical_units: N m-2 - description: mediator export - # - - standard_name: Faox_tauy - alias: stress_on_air_ocn_merid - canonical_units: N m-2 - description: mediator export - # - - standard_name: Faox_evap_16O - canonical_units: kg m-2 s-1 - description: mediator export - atm/ocn evaporation water flux 16O - # - - standard_name: Faox_evap_18O - canonical_units: kg m-2 s-1 - description: mediator export - atm/ocn evaporation water flux 18O - # - - standard_name: Faox_evap_HDO - canonical_units: kg m-2 s-1 - description: mediator export - atm/ocn evaporation water flux HDO - # - #----------------------------------- - # section: land export - #----------------------------------- - # - - standard_name: Fall_evap - canonical_units: kg m-2 s-1 - description: land export - # - - standard_name: Fall_evap_16O - canonical_units: kg m-2 s-1 - # - - standard_name: Fall_evap_18O - canonical_units: kg m-2 s-1 - description: land export - # - - standard_name: Fall_evap_HDO - canonical_units: kg m-2 s-1 - description: land export - # - - standard_name: Fall_fco2_lnd - canonical_units: moles m-2 s-1 - description: land export - # - - standard_name: Fall_fire01 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes1 - # - - standard_name: Fall_fire02 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes2 - # - - standard_name: Fall_fire03 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes3 - # - - standard_name: Fall_fire04 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes4 - # - - standard_name: Fall_fire05 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes5 - # - - standard_name: Fall_fire06 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes6 - # - - standard_name: Fall_fire07 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes7 - # - - standard_name: Fall_fire08 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes8 - # - - standard_name: Fall_fire09 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes9 - # - - standard_name: Fall_fire10 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes10 - # - - standard_name: Fall_flxdst1 - canonical_units: kg m-2 s-1 - description: land export - # - - standard_name: Fall_flxdst2 - canonical_units: kg m-2 s-1 - description: land export - # - - standard_name: Fall_flxdst3 - canonical_units: kg m-2 s-1 - description: land export - # - - standard_name: Fall_flxdst4 - canonical_units: kg m-2 s-1 - description: land export - # - - standard_name: Fall_lat - canonical_units: W m-2 - description: land export - # - - standard_name: Fall_lwup - canonical_units: W m-2 - description: land export - # - - standard_name: Fall_sen - canonical_units: W m-2 - description: land export - # - - standard_name: Fall_swnet - canonical_units: W m-2 - description: land export - # - - standard_name: Fall_taux - canonical_units: N m-2 - description: land export - # - - standard_name: Fall_tauy - canonical_units: N m-2 - description: land export - # - - standard_name: Fall_voc001 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc002 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc003 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc004 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc005 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc006 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc007 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc008 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc009 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc010 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc011 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc012 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc013 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc014 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc015 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc016 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc017 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc018 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc019 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc020 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Sl_anidf - canonical_units: 1 - description: land export - # - - standard_name: Sl_anidr - canonical_units: 1 - description: land export - # - - standard_name: Sl_avsdf - canonical_units: 1 - description: land export - # - - standard_name: Sl_avsdr - canonical_units: 1 - description: land export - # - - standard_name: Sl_dd01 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd02 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd03 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd04 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd05 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd06 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd07 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd08 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd09 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd10 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd11 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd12 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd13 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd14 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd15 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd16 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd17 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd18 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd19 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd20 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd21 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd22 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd23 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd24 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd25 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd26 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd27 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd28 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd29 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd30 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd31 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd32 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd33 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd34 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd35 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd36 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd37 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd38 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd39 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd40 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd41 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd42 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd43 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd44 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd45 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd46 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd47 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd48 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd49 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd50 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd51 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd52 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd53 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd54 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd55 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd56 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd57 - canonical_units: cm/sec - description: land export + - standard_name: Faox_evap_wiso + canonical_units: kg m-2 s-1 + description: mediator export + atm/ocn evaporation water flux 16O, 18O, HDO # - - standard_name: Sl_dd58 - canonical_units: cm/sec - description: land export + - standard_name: Faox_lat + alias: mean_laten_heat_flx_atm_into_ocn + canonical_units: W m-2 + description: mediator export + atm/ocn surface latent heat flux # - - standard_name: Sl_dd59 - canonical_units: cm/sec - description: land export + - standard_name: Faox_sen + alias: mean_sensi_heat_flx_atm_into_ocn + canonical_units: W m-2 + description: mediator export + atm/ocn surface sensible heat flux # - - standard_name: Sl_dd60 - canonical_units: cm/sec - description: land export + - standard_name: Faox_lwup + alias: mean_up_lw_flx_ocn + canonical_units: W m-2 + description: mediator export + long wave radiation flux over the ocean # - - standard_name: Sl_dd61 - canonical_units: cm/sec - description: land export + - standard_name: Faox_taux + alias: stress_on_air_ocn_zonal + canonical_units: N m-2 + description: mediator export # - - standard_name: Sl_dd62 - canonical_units: cm/sec - description: land export + - standard_name: Faox_tauy + alias: stress_on_air_ocn_merid + canonical_units: N m-2 + description: mediator export # - - standard_name: Sl_dd63 - canonical_units: cm/sec - description: land export + #----------------------------------- + # section: land export + #----------------------------------- # - - standard_name: Sl_dd64 - canonical_units: cm/sec + - standard_name: Fall_evap + canonical_units: kg m-2 s-1 description: land export # - - standard_name: Sl_dd65 - canonical_units: cm/sec - description: land export + - standard_name: Fall_evap_wiso + canonical_units: kg m-2 s-1 + description: land export # - - standard_name: Sl_dd66 - canonical_units: cm/sec + - standard_name: Fall_fco2_lnd + canonical_units: moles m-2 s-1 description: land export # - - standard_name: Sl_dd67 - canonical_units: cm/sec + - standard_name: Fall_fire + canonical_units: kg/m2/sec description: land export + wild fire emission fluxes (1->10) # - - standard_name: Sl_dd68 - canonical_units: cm/sec + - standard_name: Fall_flxdst + canonical_units: kg m-2 s-1 description: land export + dust fluxes from land (sizes 1->4) # - - standard_name: Sl_dd69 - canonical_units: cm/sec + - standard_name: Fall_lat + canonical_units: W m-2 description: land export # - - standard_name: Sl_dd70 - canonical_units: cm/sec + - standard_name: Fall_lwup + canonical_units: W m-2 description: land export # - - standard_name: Sl_dd71 - canonical_units: cm/sec + - standard_name: Fall_sen + canonical_units: W m-2 description: land export # - - standard_name: Sl_dd72 - canonical_units: cm/sec + - standard_name: Fall_swnet + canonical_units: W m-2 description: land export # - - standard_name: Sl_dd73 - canonical_units: cm/sec + - standard_name: Fall_taux + canonical_units: N m-2 description: land export # - - standard_name: Sl_dd74 - canonical_units: cm/sec + - standard_name: Fall_tauy + canonical_units: N m-2 description: land export # - - standard_name: Sl_dd75 - canonical_units: cm/sec + - standard_name: Fall_voc + canonical_units: molecules/m2/sec description: land export + MEGAN voc emission fluxes from land (1->20) # - - standard_name: Sl_dd76 - canonical_units: cm/sec + - standard_name: Sl_anidf + canonical_units: 1 description: land export # - - standard_name: Sl_dd77 - canonical_units: cm/sec + - standard_name: Sl_anidr + canonical_units: 1 description: land export # - - standard_name: Sl_dd78 - canonical_units: cm/sec + - standard_name: Sl_avsdf + canonical_units: 1 description: land export # - - standard_name: Sl_dd79 - canonical_units: cm/sec + - standard_name: Sl_avsdr + canonical_units: 1 description: land export # - - standard_name: Sl_dd80 + - standard_name: Sl_ddvel canonical_units: cm/sec - description: land export + description: land export + dry deposition velocities from (1->80) # - standard_name: Sl_fv canonical_units: m s-1 @@ -608,15 +145,7 @@ canonical_units: kg kg-1 description: land export # - - standard_name: Sl_qref_16O - canonical_units: kg kg-1 - description: land export - # - - standard_name: Sl_qref_18O - canonical_units: kg kg-1 - description: land export - # - - standard_name: Sl_qref_HDO + - standard_name: Sl_qref_wiso canonical_units: kg kg-1 description: land export # @@ -628,15 +157,7 @@ canonical_units: m description: land export # - - standard_name: Sl_snowh_16O - canonical_units: m - description: land export - # - - standard_name: Sl_snowh_18O - canonical_units: m - description: land export - # - - standard_name: Sl_snowh_HDO + - standard_name: Sl_snowh_wiso canonical_units: m description: land export # @@ -644,105 +165,25 @@ canonical_units: K description: land export # - - standard_name: Sl_topo - canonical_units: m - description: land export - # - - standard_name: Sl_topo00 - canonical_units: m - description: land export - # - - standard_name: Sl_topo01 - canonical_units: m - description: land export - # - - standard_name: Sl_topo02 - canonical_units: m - description: land export - # - - standard_name: Sl_topo03 - canonical_units: m - description: land export - # - - standard_name: Sl_topo04 - canonical_units: m - description: land export - # - - standard_name: Sl_topo05 - canonical_units: m - description: land export - # - - standard_name: Sl_topo06 - canonical_units: m - description: land export - # - - standard_name: Sl_topo07 - canonical_units: m - description: land export - # - - standard_name: Sl_topo08 + - standard_name: Sl_topo_elev canonical_units: m - description: land export - # - - standard_name: Sl_topo09 - canonical_units: m - description: land export + description: land export to mediator in elevation classes (1->glc_nec) # - - standard_name: Sl_topo10 + - standard_name: Sl_topo canonical_units: m - description: land export - # - - standard_name: Sl_tref - canonical_units: K - description: land export - # - - standard_name: Sl_tsrf - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf00 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf01 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf02 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf03 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf04 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf05 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf06 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf07 - canonical_units: deg C - description: land export + description: mediator export to glc - no levation classes # - - standard_name: Sl_tsrf08 + - standard_name: Sl_tsrf_elev canonical_units: deg C - description: land export + description: land export to mediator in elevation classes (1->glc_nec) # - - standard_name: Sl_tsrf09 + - standard_name: Sl_tsrf canonical_units: deg C - description: land export + description: mediator export to gcl with no elevation classes # - - standard_name: Sl_tsrf10 - canonical_units: deg C - description: land export + - standard_name: Sl_tref + canonical_units: K + description: mediator export to glc - no levation classes # - standard_name: Sl_u10 canonical_units: m @@ -752,47 +193,19 @@ # section: atmosphere export #----------------------------------- # - - standard_name: Faxa_bcphidry - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_bcphiwet - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_bcphodry - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_dstdry1 - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_dstdry2 - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_dstdry3 + - standard_name: Faxa_bcph canonical_units: kg m-2 s-1 description: atmosphere export # - - standard_name: Faxa_dstdry4 + - standard_name: Faxa_ocph canonical_units: kg m-2 s-1 description: atmosphere export # - - standard_name: Faxa_dstwet1 + - standard_name: Faxa_dstdry canonical_units: kg m-2 s-1 description: atmosphere export # - - standard_name: Faxa_dstwet2 - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_dstwet3 - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_dstwet4 + - standard_name: Faxa_dstwet canonical_units: kg m-2 s-1 description: atmosphere export # @@ -854,39 +267,12 @@ description: atmosphere export Instataneous net sfc uv+vis diffuse flux (fv3 only) # - - standard_name: Faxa_nhx - canonical_units: kg(N)/m2/sec - description: atmosphere export - # - - standard_name: Faxa_noy + - standard_name: Faxa_ndep canonical_units: kg(N)/m2/sec - description: atmosphere export - # - - standard_name: Faxa_ocphidry - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_ocphiwet - canonical_units: kg m-2 s-1 - description: atmosphere export + description: atmosphere export to land and ocean + currently nhx and noy # - - standard_name: Faxa_ocphodry - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_prec - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_prec_16O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_prec_18O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_prec_HDO + - standard_name: Faxa_prec_wiso canonical_units: kg m-2 s-1 description: atmosphere export # @@ -895,15 +281,8 @@ canonical_units: kg m-2 s-1 description: atmosphere export # - - standard_name: Faxa_rain_16O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rain_18O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rain_HDO + - standard_name: Faxa_rain_wiso + alias: mean_prec_rate_wiso canonical_units: kg m-2 s-1 description: atmosphere export # @@ -911,15 +290,7 @@ canonical_units: kg m-2 s-1 description: atmosphere export # - - standard_name: Faxa_rainc_16O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rainc_18O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rainc_HDO + - standard_name: Faxa_rainc_wiso canonical_units: kg m-2 s-1 description: atmosphere export # @@ -927,15 +298,7 @@ canonical_units: kg m-2 s-1 description: atmosphere export # - - standard_name: Faxa_rainl_16O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rainl_18O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rainl_HDO + - standard_name: Faxa_rainl_wiso canonical_units: kg m-2 s-1 description: atmosphere export # @@ -944,15 +307,7 @@ canonical_units: kg m-2 s-1 description: atmosphere export # - - standard_name: Faxa_snow_16O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snow_18O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snow_HDO + - standard_name: Faxa_snow_wiso canonical_units: kg m-2 s-1 description: atmosphere export # @@ -960,15 +315,7 @@ canonical_units: kg m-2 s-1 description: atmosphere export # - - standard_name: Faxa_snowc_16O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snowc_18O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snowc_HDO + - standard_name: Faxa_snowc_wiso canonical_units: kg m-2 s-1 description: atmosphere export # @@ -976,15 +323,7 @@ canonical_units: kg m-2 s-1 description: atmosphere export # - - standard_name: Faxa_snowl_16O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snowl_18O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snowl_HDO + - standard_name: Faxa_snowl_wiso canonical_units: kg m-2 s-1 description: atmosphere export # @@ -1081,20 +420,11 @@ description: atmosphere export bottom layer specific humidity # - - standard_name: Sa_shum_16O + - standard_name: Sa_shum_wiso + alias: inst_spec_humid_height_lowest_wiso canonical_units: kg kg-1 description: atmosphere export - bottom layer specific humidity 16O (cesm only) - # - - standard_name: Sa_shum_18O - canonical_units: kg kg-1 - description: atmosphere export - bottom layer specific humidity 18O (cesm only) - # - - standard_name: Sa_shum_HDO - canonical_units: kg kg-1 - description: atmosphere export - bottom layer specific humidity HDO (cesm only) + bottom layer specific humidity 16O, 18O, HDO (cesm only) # - standard_name: inst_spec_humid_height2m canonical_units: K @@ -1323,15 +653,7 @@ canonical_units: kg m-2 s-1 description: atmosphere import # - - standard_name: Faxx_evap_16O - canonical_units: kg m-2 s-1 - description: atmosphere import - # - - standard_name: Faxx_evap_18O - canonical_units: kg m-2 s-1 - description: atmosphere import - # - - standard_name: Faxx_evap_HDO + - standard_name: Faxx_evap_wiso canonical_units: kg m-2 s-1 description: atmosphere import # @@ -1385,14 +707,7 @@ canonical_units: kg kg-1 description: atmosphere import # - - standard_name: Sx_qref_16O - canonical_units: kg kg-1 - # - - standard_name: Sx_qref_18O - canonical_units: kg kg-1 - description: atmosphere import - # - - standard_name: Sx_qref_HDO + - standard_name: Sx_qref_wiso canonical_units: kg kg-1 description: atmosphere import # @@ -1420,126 +735,28 @@ description: land-ice export glc frozen runoff_iceberg flux to ice # - - standard_name: Figg_rofi_16O - canonical_units: kg m-2 s-1 - description: land-ice export - glc frozen runoff_iceberg flux to ice for 16O - # - - standard_name: Figg_rofi_18O + - standard_name: Figg_rofi_wiso canonical_units: kg m-2 s-1 description: land-ice export - glc frozen runoff_iceberg flux to ice for 18O - # - - standard_name: Figg_rofi_HDO - canonical_units: kg m-2 s-1 - description: land-ice export - glc frozen runoff_iceberg flux to ice for HDO + glc frozen runoff_iceberg flux to ice for 16O, 18O, HDO # - standard_name: Flgg_hflx canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from glc - # - - standard_name: Flgg_hflx00 - canonical_units: W m-2 - description: land-ice export + description: land-ice export to mediator (no elevatino classes) Downward heat flux from glacier interior, from mediator, elev class 0 # - - standard_name: Flgg_hflx01 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 1 - # - - standard_name: Flgg_hflx02 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 2 - # - - standard_name: Flgg_hflx03 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 3 - # - - standard_name: Flgg_hflx04 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 4 - # - - standard_name: Flgg_hflx05 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 5 - # - - standard_name: Flgg_hflx06 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 6 - # - - standard_name: Flgg_hflx07 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 7 - # - - standard_name: Flgg_hflx08 + - standard_name: Flgg_hflx_elev canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 8 - # - - standard_name: Flgg_hflx09 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 8 + description: mediator land-ice export to lnd (elevation classes 1->glc_nec) + Downward heat flux from glacier interior, from mediator, elev class 1->glc_nec # - - standard_name: Flgg_hflx10 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 10 - standard_name: Sg_ice_covered canonical_units: 1 + description: land-ice export to mediator (no elevation classes) # - - standard_name: Sg_ice_covered00 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered01 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered02 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered03 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered04 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered05 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered06 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered07 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered08 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered09 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered10 + - standard_name: Sg_ice_covered_elev canonical_units: 1 - description: land-ice export + description: mediator land-ice export to lnd (elevation classes 1->glc_nec) # - standard_name: Sg_icemask canonical_units: 1 @@ -1551,91 +768,31 @@ # - standard_name: Sg_topo canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo00 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo01 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo02 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo03 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo04 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo05 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo06 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo07 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo08 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo09 - canonical_units: m - description: land-ice export + description: land-ice export to mediator (no elevation classes) # - - standard_name: Sg_topo10 + - standard_name: Sg_topo_elev canonical_units: m - description: land-ice export + description: mediator land-ice export to lnd (elevation classes 1->glc_nec) # - standard_name: Fogg_rofi canonical_units: kg m-2 s-1 description: land-ice export glacier_frozen_runoff_flux_to_ocean # - - standard_name: Fogg_rofi_16O - canonical_units: kg m-2 s-1 - description: land-ice export - glacier_frozen_runoff_flux_to_ocean for 16O - # - - standard_name: Fogg_rofi_18O + - standard_name: Fogg_rofi_wiso canonical_units: kg m-2 s-1 description: land-ice export - glacier_frozen_runoff_flux_to_ocean for 18O - # - - standard_name: Fogg_rofi_HDO - canonical_units: kg m-2 s-1 - description: land-ice export - glacier_frozen_runoff_flux_to_ocean for HDO + glacier_frozen_runoff_flux_to_ocean for 16O, 18O, HDO # - standard_name: Fogg_rofl canonical_units: kg m-2 s-1 description: land-ice export glacier liquid runoff flux to ocean # - - standard_name: Fogg_rofl_16O - canonical_units: kg m-2 s-1 - description: land-ice export - glacier_frozen_runoff_flux_to_ocean for 16O - # - - standard_name: Fogg_rofl_18O - canonical_units: kg m-2 s-1 - description: land-ice export - glacier_frozen_runoff_flux_to_ocean for 18O - # - - standard_name: Fogg_rofl_HDO + - standard_name: Fogg_rofl_wiso canonical_units: kg m-2 s-1 description: land-ice export - glacier_frozen_runoff_flux_to_ocean for HDO + glacier_frozen_runoff_flux_to_ocean for 16O, 18O, HDO # #----------------------------------- # section: sea-ice export @@ -1646,17 +803,9 @@ canonical_units: kg m-2 s-1 description: sea-ice export # - - standard_name: Faii_evap_16O - canonical_units: kg m-2 s-1 - description: sea-ice export - # - - standard_name: Faii_evap_18O + - standard_name: Faii_evap_wiso canonical_units: kg m-2 s-1 - description: sea-ice export - # - - standard_name: Faii_evap_HDO - canonical_units: kg m-2 s-1 - description: sea-ice export + description: sea-ice export for 16O, 18O, HDO # - standard_name: Faii_lat alias: mean_laten_heat_flx_atm_into_ice @@ -1713,15 +862,10 @@ description: sea-ice export to ocean net heat flux to ocean # - - standard_name: Fioi_melth_16O + - standard_name: Fioi_melth_wiso canonical_units: kg m-2 s-1 description: sea-ice export to ocean - isotope head flux to ocean - # - - standard_name: Fioi_melth_18O - canonical_units: kg m-2 s-1 - description: sea-ice export to ocean - isotope head flux to ocean + isotope head flux to ocean for 16O, 18O, HDO # - standard_name: Fioi_melth_HDO canonical_units: kg m-2 s-1 @@ -1734,17 +878,11 @@ description: sea-ice export to ocean fresh water to ocean (h2o flux from melting) # - - standard_name: Fioi_meltw_16O - canonical_units: kg m-2 s-1 - description: sea-ice export - # - - standard_name: Fioi_meltw_18O + - standard_name: Fioi_meltw_wiso + alias: mean_fresh_water_to_ocean_rate_wiso canonical_units: kg m-2 s-1 - description: sea-ice export - # - - standard_name: Fioi_meltw_HDO - canonical_units: kg m-2 s-1 - description: sea-ice export + description: sea-ice export to ocean + fresh water to ocean (h2o flux from melting) for 16O, 18O, HDO # - standard_name: Fioi_salt alias: mean_salt_rate @@ -1760,28 +898,28 @@ # # NOTE: the following alias requires a new name change for CICE export - standard_name: Fioi_swpen_vdr - alias: mean_net_swpen_vis_dir_flx + alias: mean_net_sw_vis_dir_flx canonical_units: W m-2 description: sea-ice export to ocean flux of vis dir shortwave through ice to ocean # # NOTE: the following alias requires a new name change for CICE export - standard_name: Fioi_swpen_vdf - alias: mean_net_swpen_vis_dif_flx + alias: mean_net_sw_vis_dif_flx canonical_units: W m-2 description: sea-ice export to ocean flux of vif dir shortwave through ice to ocean # # NOTE: the following alias requires a new name change for CICE export - standard_name: Fioi_swpen_idr - alias: mean_net_swpen_ir_dir_flx + alias: mean_net_sw_ir_dir_flx canonical_units: W m-2 description: sea-ice export to ocean flux of ir dir shortwave through ice to ocean # # NOTE: the following alias requires a new name change for CICE export - standard_name: Fioi_swpen_idf - alias: mean_net_swpen_ir_dif_flx + alias: mean_net_sw_ir_dif_flx canonical_units: W m-2 description: sea-ice export to ocean flux of ir dif shortwave through ice to ocean @@ -1825,6 +963,7 @@ ice fraction (varies with time) # - standard_name: Si_ifrac_n + alias: ice_fraction_n canonical_units: 1 description: sea-ice export ice fraction per category (varies with time) (cesm only) @@ -1840,21 +979,11 @@ description: sea-ice export to atm cesm only # - - standard_name: Si_qref_16O - canonical_units: kg kg-1 - description: sea-ice export to atm - cesm only - # - - standard_name: Si_qref_18O + - standard_name: Si_qref_wiso canonical_units: kg kg-1 description: sea-ice export to atm cesm only # - - standard_name: Si_qref_HDO - canonical_units: kg kg-1 - description: sea-ice export - cesm only - # - standard_name: Si_snowh # ambiguous with Si_vsno # alias: mean_snow_volume @@ -1888,7 +1017,7 @@ volume of snow per unit area # #----------------------------------- - # section: ocean export + # section: ocean export to mediator #----------------------------------- # - standard_name: Fioo_q @@ -1898,23 +1027,23 @@ # - standard_name: Faoo_fco2_ocn canonical_units: moles m-2 s-1 - description: ocean export + description: ocean export (cesm only) # - standard_name: So_anidf canonical_units: 1 - description: ocean export + description: ocean export (cesm only) # - standard_name: So_anidr canonical_units: 1 - description: ocean export + description: ocean export (cesm only) # - standard_name: So_avsdf canonical_units: 1 - description: ocean export + description: ocean export (cesm only) # - standard_name: So_avsdr canonical_units: 1 - description: ocean export + description: ocean export (cesm only) # - standard_name: So_bldepth alias: mixed_layer_depth @@ -1944,6 +1073,7 @@ description: ocean export # - standard_name: So_omask + alias: ocean_mask canonical_units: 1 description: ocean export # @@ -1951,15 +1081,7 @@ canonical_units: kg kg-1 description: ocean export # - - standard_name: So_qref_16O - canonical_units: kg kg-1 - description: ocean export - # - - standard_name: So_qref_18O - canonical_units: kg kg-1 - description: ocean export - # - - standard_name: So_qref_HDO + - standard_name: So_qref_wiso canonical_units: kg kg-1 description: ocean export # @@ -1967,12 +1089,12 @@ canonical_units: 1 description: ocean export # - - standard_name: So_roce_16O - canonical_units: 1 + - standard_name: So_qref_wiso + canonical_units: kg kg-1 description: ocean export # - - standard_name: So_roce_HDO - canonical_units: 1 + - standard_name: So_roce_wiso + canonical_units: unitless description: ocean export # - standard_name: So_s @@ -2020,36 +1142,18 @@ description: river export water flux into sea ice due to runoff (frozen) # - - standard_name: Firr_rofi_16O + - standard_name: Firr_rofi_wiso canonical_units: kg m-2 s-1 description: river export - water flux into sea ice due to runoff (frozen) for 16O - # - - standard_name: Firr_rofi_18O - canonical_units: kg m-2 s-1 - description: river export - water flux into sea ice due to runoff (frozen) for 18O - # - - standard_name: Firr_rofi_HDO - canonical_units: kg m-2 s-1 - description: river export - water flux into sea ice due to runoff (frozen) for HDO + water flux into sea ice due to runoff (frozen) for 16O, 18O, HDO # - standard_name: Fixx_rofi canonical_units: kg m-2 s-1 description: frozen runoff to ice from river and land-ice # - - standard_name: Fixx_rofi_16O - canonical_units: kg m-2 s-1 - description: frozen runoff to ice from river and land-ice for 16O - # - - standard_name: Fixx_rofi_18O + - standard_name: Fixx_rofi_wiso canonical_units: kg m-2 s-1 - description: frozen runoff to ice from river and land-ice for 18O - # - - standard_name: Fixx_rofi_HDO - canonical_units: kg m-2 s-1 - description: frozen runoff to ice from river and land-ice for HDO + description: frozen runoff to ice from river and land-ice for 16O, 18O, HDO # #----------------------------------- # section: lnd export to glc @@ -2057,51 +1161,11 @@ # - standard_name: Flgl_qice canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice00 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice01 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice02 - canonical_units: kg m-2 s-1 - description: land export to glc + description: mediator export to glc no elevation classes # - - standard_name: Flgl_qice03 + - standard_name: Flgl_qice_elev canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice04 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice05 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice06 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice07 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice08 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice09 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice10 - canonical_units: kg m-2 s-1 - description: land export to glc + description: land export to mediator in elevation classes (1->glc_nec) # #----------------------------------- # section: lnd export to river @@ -2140,100 +1204,50 @@ description: river export to land Water flux due to flooding # - - standard_name: Flrr_flood_16O - canonical_units: kg m-2 s-1 - description: river export to land - Water flux due to flooding for 16O - # - - standard_name: Flrr_flood_18O - canonical_units: kg m-2 s-1 - description: river export to land - Water flux due to flooding for 18O - # - - standard_name: Flrr_flood_HDO + - standard_name: Flrr_flood_wiso canonical_units: kg m-2 s-1 description: river export to land - Water flux due to flooding for HDO + Water flux due to flooding for 16O, 18O, HDO # - standard_name: Flrr_volr canonical_units: m description: river export to land River channel total water volume # - - standard_name: Flrr_volr_16O - canonical_units: m - description: river export to land - River channel total water volume from 16O - # - - standard_name: Flrr_volr_18O - canonical_units: m - description: river export to land - River channel total water volume from 18O - # - - standard_name: Flrr_volr_HDO + - standard_name: Flrr_volr_wiso canonical_units: m description: river export to land - River channel total water olume from HDO + River channel total water volume from 16O, 18O, HDO # - standard_name: Flrr_volrmch canonical_units: m description: river export to land River channel main channel water volume # - - standard_name: Flrr_volrmch_16O - canonical_units: m - description: river export to land - River channel main channel water volume from 16O - # - - standard_name: Flrr_volrmch_18O - canonical_units: m - description: river export to land - River channel main channel water volume from 18O - # - - standard_name: Flrr_volrmch_HDO + - standard_name: Flrr_volrmch_wiso canonical_units: m description: river export to land - River channel main channel water volume from HDO + River channel main channel water volume from 16O, 18O, HDO # - standard_name: Forr_rofi canonical_units: kg m-2 s-1 description: river export to ocean Water flux due to runoff (frozen) # - - standard_name: Forr_rofi_16O + - standard_name: Forr_rofi_wiso canonical_units: kg m-2 s-1 description: river export to ocean - Water flux due to runoff (frozen) for 16O - # - - standard_name: Forr_rofi_18O - canonical_units: kg m-2 s-1 - description: river export to ocean - Water flux due to runoff (frozen) for 18O - # - - standard_name: Forr_rofi_HDO - canonical_units: kg m-2 s-1 - description: river export to ocean - Water flux due to runoff (frozen) for HDO + Water flux due to runoff (frozen) for 16O, 18O, HDO # - standard_name: Forr_rofl canonical_units: kg m-2 s-1 description: river export to ocean Water flux due to runoff (liquid) # - - standard_name: Forr_rofl_16O - canonical_units: kg m-2 s-1 - description: river export to ocean - Water flux due to runoff (frozen) for 16O - # - - standard_name: Forr_rofl_18O - canonical_units: kg m-2 s-1 - description: river export to ocean - Water flux due to runoff (frozen) for 18O - # - - standard_name: Forr_rofl_HDO + - standard_name: Forr_rofl_wiso canonical_units: kg m-2 s-1 description: river export to ocean - Water flux due to runoff (frozen) for HDO + Water flux due to runoff (frozen) for 16O, 18O, HDO # #----------------------------------- # section: ocean import @@ -2245,40 +1259,21 @@ description: ocean import specific humidity flux # - - standard_name: Foxx_evap_16O - canonical_units: kg m-2 s-1 - description: ocean import - specific humidity flux 16O - # - - standard_name: Foxx_evap_18O - canonical_units: kg m-2 s-1 - description: ocean import - specific humidity flux 18O - # - - standard_name: Foxx_evap_HDO + - standard_name: Foxx_evap_wiso + alias: mean_evap_rate_wiso canonical_units: kg m-2 s-1 description: ocean import - specific humidity flux HDO + specific humidity flux 16O, 18O, HDO # - standard_name: Foxx_lat canonical_units: W m-2 description: ocean import latent heat flux into ocean (cesm only) # - - standard_name: Foxx_lat_16O - canonical_units: W m-2 - description: ocean import - latent heat flux into ocean for 16O (cesm only) - # - - standard_name: Foxx_lat_18O - canonical_units: W m-2 - description: ocean import - latent heat flux into ocean for 16O (cesm only) - # - - standard_name: Foxx_lat_HDO + - standard_name: Foxx_lat_wiso canonical_units: W m-2 description: ocean import - latent heat flux into ocean for 18O (cesm only) + latent heat flux into ocean for 16O, 18O, HDO (cesm only) # - standard_name: Foxx_lat canonical_units: W m-2 @@ -2302,45 +1297,46 @@ description: ocean import mean NET long wave radiation flux to ocean # - - standard_name: Foxx_rofi + - standard_name: mean_runoff_rate canonical_units: kg m-2 s-1 description: ocean import - water flux due to runoff (frozen) + total runoff to ocean # - - standard_name: Foxx_rofi_16O + - standard_name: mean_runoff_heat_flux canonical_units: kg m-2 s-1 description: ocean import - water flux due to runoff (frozen) for 16O + heat content of runoff # - - standard_name: Foxx_rofi_18O + - standard_name: mean_calving_rate canonical_units: kg m-2 s-1 description: ocean import - water flux due to runoff (frozen) for 18O + total calving to ocean # - - standard_name: Foxx_rofi_HDO + - standard_name: mean_calving_heat_flux canonical_units: kg m-2 s-1 description: ocean import - water flux due to runoff (frozen) for HDO + heat content of calving # - - standard_name: Foxx_rofl + - standard_name: Foxx_rofi canonical_units: kg m-2 s-1 description: ocean import - water flux due to runoff (liquid) + water flux due to runoff (frozen) # - - standard_name: Foxx_rofl_16O + - standard_name: Foxx_rofi_wiso canonical_units: kg m-2 s-1 description: ocean import - water flux due to runoff (liquid) for 16O + water flux due to runoff (frozen) for 16O, 18O, HDO # - - standard_name: Foxx_rofl_18O + - standard_name: Foxx_rofl + alias: mean_runoff_rate canonical_units: kg m-2 s-1 description: ocean import - water flux due to runoff (liquid) for 18O + water flux due to runoff (liquid) # - - standard_name: Foxx_rofl_HDO + - standard_name: Foxx_rofl_wiso canonical_units: kg m-2 s-1 description: ocean import - water flux due to runoff (liquid) for HDO + water flux due to runoff (liquid) for 16O, 18O, HDO # - standard_name: Foxx_swnet alias: mean_net_sw_flx @@ -2390,6 +1386,7 @@ meridional surface stress # - standard_name: Fioi_swpen_ifrac_n + alias: mean_sw_pen_to_ocn_ifrac_n canonical_units: W m-2 description: ocean import net shortwave radiation penetrating into ice and ocean times ice fraction for thickness category 1 diff --git a/src/drivers/nuopc/cime_flds_shr/seq_drydep_mod.F90 b/src/drivers/nuopc/cime_flds_shr/seq_drydep_mod.F90 index 225b561c91fd..93bd212a2a66 100644 --- a/src/drivers/nuopc/cime_flds_shr/seq_drydep_mod.F90 +++ b/src/drivers/nuopc/cime_flds_shr/seq_drydep_mod.F90 @@ -19,12 +19,9 @@ module seq_drydep_mod use shr_sys_mod, only : shr_sys_abort use shr_log_mod, only : s_loglev => shr_log_Level use shr_kind_mod, only : r8 => shr_kind_r8, CS => SHR_KIND_CS, CX => SHR_KIND_CX - use shr_const_mod, only : SHR_CONST_G, SHR_CONST_RDAIR, & - SHR_CONST_CPDAIR, SHR_CONST_MWWV + use shr_const_mod, only : SHR_CONST_G, SHR_CONST_RDAIR, SHR_CONST_CPDAIR, SHR_CONST_MWWV implicit none - save - private ! !PUBLIC MEMBER FUNCTIONS @@ -35,18 +32,18 @@ module seq_drydep_mod ! !PRIVATE ARRAY SIZES - integer, private, parameter :: maxspc = 100 ! Maximum number of species integer, public, parameter :: n_species_table = 77 ! Number of species to work with + integer, private, parameter :: maxspc = 100 ! Maximum number of species integer, private, parameter :: NSeas = 5 ! Number of seasons integer, private, parameter :: NLUse = 11 ! Number of land-use types ! !PUBLIC DATA MEMBERS: ! method specification - character(16),public,parameter :: DD_XATM = 'xactive_atm'! dry-dep atmosphere - character(16),public,parameter :: DD_XLND = 'xactive_lnd'! dry-dep land - character(16),public,parameter :: DD_TABL = 'table' ! dry-dep table (atm and lnd) - character(16),public :: drydep_method = DD_XLND ! Which option choosen + character(16),public,parameter :: DD_XATM = 'xactive_atm' ! dry-dep atmosphere + character(16),public,parameter :: DD_XLND = 'xactive_lnd' ! dry-dep land + character(16),public,parameter :: DD_TABL = 'table' ! dry-dep table (atm and lnd) + character(16),public :: drydep_method = DD_XLND ! Which option choosen real(r8), public, parameter :: ph = 1.e-5_r8 ! measure of the acidity (dimensionless) @@ -54,11 +51,10 @@ module seq_drydep_mod integer, public :: n_drydep = 0 ! Number in drypdep list character(len=CS), public, dimension(maxspc) :: drydep_list = '' ! List of dry-dep species - character(len=CS), public :: drydep_fields_token = '' ! First drydep fields token - real(r8), public, allocatable, dimension(:) :: foxd ! reactivity factor for oxidation (dimensioness) real(r8), public, allocatable, dimension(:) :: drat ! ratio of molecular diffusivity (D_H2O/D_species; dimensionless) integer, public, allocatable, dimension(:) :: mapping ! mapping to species table + ! --- Indices for each species --- integer, public :: h2_ndx, ch4_ndx, co_ndx, pan_ndx, mpan_ndx, so2_ndx, o3_ndx, o3a_ndx, xpan_ndx @@ -504,41 +500,37 @@ module seq_drydep_mod !==================================================================================== - subroutine seq_drydep_readnl(NLFilename, seq_drydep_fields, seq_drydep_nflds) + subroutine seq_drydep_readnl(NLFilename, drydep_nflds) !======================================================================== - ! reads drydep_inparm namelist and sets up CCSM driver list of fields for - ! land-atmosphere communications. - ! - ! !REVISION HISTORY: - ! 2009-Feb-20 - E. Kluzek - Separate out as subroutine from previous input_init + ! reads drydep_inparm namelist and determines the number of drydep velocity + ! fields that are sent from the land component !======================================================================== - use ESMF, only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast - use shr_file_mod,only : shr_file_getUnit, shr_file_freeUnit - use shr_log_mod, only : s_logunit => shr_log_Unit - use shr_mpi_mod, only : shr_mpi_bcast - use shr_nl_mod, only : shr_nl_find_group_name - implicit none + + use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast + use shr_file_mod, only : shr_file_getUnit, shr_file_freeUnit + use shr_log_mod , only : s_logunit => shr_log_Unit + use shr_mpi_mod , only : shr_mpi_bcast + use shr_nl_mod , only : shr_nl_find_group_name character(len=*), intent(in) :: NLFilename ! Namelist filename - character(len=*), intent(out) :: seq_drydep_fields - integer, intent(out) :: seq_drydep_nflds + integer, intent(out) :: drydep_nflds + !----- local ----- - integer :: i ! Indices - integer :: unitn ! namelist unit number - integer :: ierr ! error code - logical :: exists ! if file exists or not - character(len=8) :: token ! dry dep field name to add + integer :: i ! Indices + integer :: unitn ! namelist unit number + integer :: ierr ! error code + logical :: exists ! if file exists or not type(ESMF_VM) :: vm - integer :: localPet - integer :: tmp(1) - integer :: rc - !----- formats ----- + integer :: localPet + integer :: tmp(1) + integer :: rc character(*),parameter :: subName = '(seq_drydep_read) ' character(*),parameter :: F00 = "('(seq_drydep_read) ',8a)" character(*),parameter :: FI1 = "('(seq_drydep_init) ',a,I2)" namelist /drydep_inparm/ drydep_list, drydep_method + !----------------------------------------------------------------------------- !----------------------------------------------------------------------------- ! Read namelist and figure out the drydep field list to pass @@ -551,7 +543,8 @@ subroutine seq_drydep_readnl(NLFilename, seq_drydep_fields, seq_drydep_nflds) end if call ESMF_VMGetCurrent(vm, rc=rc) call ESMF_VMGet(vm, localPet=localPet, rc=rc) - seq_drydep_nflds=0 + + drydep_nflds=0 if (localPet==0) then inquire( file=trim(NLFileName), exist=exists) if ( exists ) then @@ -575,41 +568,31 @@ subroutine seq_drydep_readnl(NLFilename, seq_drydep_fields, seq_drydep_nflds) call shr_file_freeUnit( unitn ) do i=1,maxspc if(len_trim(drydep_list(i)) > 0) then - seq_drydep_nflds=seq_drydep_nflds+1 + drydep_nflds=drydep_nflds+1 endif enddo end if end if - tmp = seq_drydep_nflds + + tmp = drydep_nflds call ESMF_VMBroadcast(vm, tmp, 1, 0, rc=rc) - seq_drydep_nflds = tmp(1) - if(seq_drydep_nflds > 0) then - call ESMF_VMBroadcast(vm, drydep_list, CS*seq_drydep_nflds, 0, rc=rc) + drydep_nflds = tmp(1) + if (drydep_nflds > 0) then + call ESMF_VMBroadcast(vm, drydep_list, CS*drydep_nflds, 0, rc=rc) call ESMF_VMBroadcast(vm, drydep_method, 16, 0, rc=rc) endif - !--- Loop over species to fill list of fields to communicate for drydep --- - seq_drydep_fields = ' ' - do i=1,seq_drydep_nflds - write(token,333) i - seq_drydep_fields = trim(seq_drydep_fields)//':'//trim(token) - if ( i == 1 ) then - seq_drydep_fields = trim(token) - drydep_fields_token = trim(token) - endif - enddo - !--- Make sure method is valid and determine if land is passing drydep fields --- - lnd_drydep = seq_drydep_nflds>0 .and. drydep_method == DD_XLND + lnd_drydep = (drydep_nflds>0 .and. drydep_method == DD_XLND) if (localpet==0) then if ( s_loglev > 0 ) then write(s_logunit,*) 'seq_drydep_read: drydep_method: ', trim(drydep_method) - if ( seq_drydep_nflds == 0 )then + if ( drydep_nflds == 0 )then write(s_logunit,F00) 'No dry deposition fields will be transfered' else - write(s_logunit,FI1) 'Number of dry deposition fields transfered is ', seq_drydep_nflds + write(s_logunit,FI1) 'Number of dry deposition fields transfered is ', drydep_nflds end if end if end if @@ -625,9 +608,6 @@ subroutine seq_drydep_readnl(NLFilename, seq_drydep_fields, seq_drydep_nflds) call shr_sys_abort('seq_drydep_read: incorrect dry deposition method specification') endif - ! Need to explicitly add Sl_ based on naming convention -333 format ('Sl_dd',i3.3) - end subroutine seq_drydep_readnl !==================================================================================== diff --git a/src/drivers/nuopc/cime_flds_shr/shr_carma_mod.F90 b/src/drivers/nuopc/cime_flds_shr/shr_carma_mod.F90 index d6d0e543ac52..c00f35beedb1 100644 --- a/src/drivers/nuopc/cime_flds_shr/shr_carma_mod.F90 +++ b/src/drivers/nuopc/cime_flds_shr/shr_carma_mod.F90 @@ -1,14 +1,10 @@ -!================================================================================ -! This reads the carma_inparm namelist in drv_flds_in and makes the relavent -! information available to CAM, CLM, and driver. The driver sets up CLM to CAM -! communication for the VOC flux fields. CLM needs to know what specific VOC -! fluxes need to be passed to the coupler and how to assimble the fluxes. -! CAM needs to know what specific VOC fluxes to expect from CLM. -! -! Mariana Vertenstein -- 24 Sep 2012 -!================================================================================ module shr_carma_mod + !================================================================================ + ! This reads the carma_inparm namelist in drv_flds_in and makes the relavent + ! information available to CAM, CLM, and driver. + !================================================================================ + use shr_kind_mod , only : r8 => shr_kind_r8, CX => SHR_KIND_CX use shr_sys_mod , only : shr_sys_abort use shr_log_mod , only : loglev => shr_log_Level @@ -17,19 +13,23 @@ module shr_carma_mod use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit implicit none - save private public :: shr_carma_readnl ! reads carma_inparm namelist +!------------------------------------------------------------------------- contains +!------------------------------------------------------------------------- - !------------------------------------------------------------------------- - ! This reads the carma_emis_nl namelist group in drv_flds_in and parses the - ! namelist information for the driver, CLM, and CAM. - !------------------------------------------------------------------------- subroutine shr_carma_readnl( NLFileName, carma_fields) + + !------------------------------------------------------------------------- + ! This reads the carma_emis_nl namelist group in drv_flds_in and parses the + ! namelist information for the driver, CLM, and CAM. + !------------------------------------------------------------------------- + use ESMF, only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VMBroadcast + character(len=*) , intent(in) :: NLFileName character(len=CX), intent(out) :: carma_fields diff --git a/src/drivers/nuopc/cime_flds_shr/shr_fire_emis_mod.F90 b/src/drivers/nuopc/cime_flds_shr/shr_fire_emis_mod.F90 index ae4220d281f1..a86a0d393cd3 100644 --- a/src/drivers/nuopc/cime_flds_shr/shr_fire_emis_mod.F90 +++ b/src/drivers/nuopc/cime_flds_shr/shr_fire_emis_mod.F90 @@ -1,12 +1,13 @@ -!================================================================================ -! Coordinates carbon emissions fluxes from CLM fires for use as sources of -! chemical constituents in CAM -! -! This module reads fire_emis_nl namelist which specifies the compound fluxes -! that are to be passed through the model coupler. -!================================================================================ module shr_fire_emis_mod + !================================================================================ + ! Coordinates carbon emissions fluxes from CLM fires for use as sources of + ! chemical constituents in CAM + ! + ! This module reads fire_emis_nl namelist which specifies the compound fluxes + ! that are to be passed through the model coupler. + !================================================================================ + use shr_kind_mod , only : r8 => shr_kind_r8 use shr_kind_mod , only : CL => SHR_KIND_CL, CX => SHR_KIND_CX, CS => SHR_KIND_CS use shr_sys_mod , only : shr_sys_abort @@ -29,10 +30,9 @@ module shr_fire_emis_mod logical :: shr_fire_emis_elevated = .true. - character(len=CS), public :: shr_fire_emis_fields_token = '' ! emissions fields token character(len=CL), public :: shr_fire_emis_factors_file = '' ! a table of basic fire emissions compounds character(len=CS), public :: shr_fire_emis_ztop_token = 'Sl_fztop' ! token for emissions top of vertical distribution - integer, parameter :: name_len=16 + integer, parameter :: name_len=16 ! fire emissions component data structure (or user defined type) type shr_fire_emis_comp_t @@ -61,56 +61,61 @@ module shr_fire_emis_mod integer :: shr_fire_emis_comps_n = 0 ! number of unique fire components integer :: shr_fire_emis_mechcomps_n = 0 ! number of unique compounds in the CAM chemical mechanism that have fire emissions +!------------------------------------------------------------------------- contains - - !------------------------------------------------------------------------- - ! - ! This reads the fire_emis_nl namelist group in drv_flds_in and parses the - ! namelist information for the driver, CLM, and CAM. - ! - ! Namelist variables: - ! fire_emis_specifier, fire_emis_factors_file, fire_emis_elevated - ! - ! fire_emis_specifier (array of strings) -- Each array element specifies - ! how CAM-Chem constituents are mapped to basic smoke compounds in - ! the fire emissions factors table (fire_emis_factors_file). Each - ! chemistry constituent name (left of '=' sign) is mapped to one or more - ! smoke compound (separated by + sign if more than one), which can be - ! proceeded by a multiplication factor (separated by '*'). - ! Example: - ! fire_emis_specifier = 'bc_a1 = BC','pom_a1 = 1.4*OC','SO2 = SO2' - ! - ! fire_emis_factors_file (string) -- Input file that contains the table - ! of basic compounds that make up the smoke from the CLM fires. This is - ! used in CLM module FireEmisFactorsMod. - ! - ! fire_emis_elevated (locical) -- If true then CAM-Chem treats the fire - ! emission sources as 3-D vertically distributed forcings for the - ! corresponding chemical tracers. - ! - !------------------------------------------------------------------------- - subroutine shr_fire_emis_readnl( NLFileName, emis_fields, emis_nflds ) - use ESMF, only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VMBroadcast - use shr_nl_mod, only : shr_nl_find_group_name - use shr_file_mod, only : shr_file_getUnit, shr_file_freeUnit - - +!------------------------------------------------------------------------- + + subroutine shr_fire_emis_readnl( NLFileName, emis_nflds ) + + !------------------------------------------------------------------------- + ! + ! This reads the fire_emis_nl namelist group in drv_flds_in and parses the + ! namelist information for the driver, CLM, and CAM. + ! + ! Namelist variables: + ! fire_emis_specifier, fire_emis_factors_file, fire_emis_elevated + ! + ! fire_emis_specifier (array of strings) -- Each array element specifies + ! how CAM-Chem constituents are mapped to basic smoke compounds in + ! the fire emissions factors table (fire_emis_factors_file). Each + ! chemistry constituent name (left of '=' sign) is mapped to one or more + ! smoke compound (separated by + sign if more than one), which can be + ! proceeded by a multiplication factor (separated by '*'). + ! Example: + ! fire_emis_specifier = 'bc_a1 = BC','pom_a1 = 1.4*OC','SO2 = SO2' + ! + ! fire_emis_factors_file (string) -- Input file that contains the table + ! of basic compounds that make up the smoke from the CLM fires. This is + ! used in CLM module FireEmisFactorsMod. + ! + ! fire_emis_elevated (locical) -- If true then CAM-Chem treats the fire + ! emission sources as 3-D vertically distributed forcings for the + ! corresponding chemical tracers. + ! + !------------------------------------------------------------------------- + + use ESMF , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VMBroadcast + use shr_nl_mod , only : shr_nl_find_group_name + use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit + + ! input/output variables character(len=*), intent(in) :: NLFileName ! name of namelist file - character(len=*), intent(out) :: emis_fields ! emis flux fields integer, intent(out) :: emis_nflds - type(ESMF_VM) :: vm - integer :: localPet - integer :: rc - integer :: unitn ! namelist unit number - integer :: ierr ! error code - logical :: exists ! if file exists or not - integer, parameter :: maxspc = 100 - character(len=2*CX) :: fire_emis_specifier(maxspc) = ' ' - character(len=CL) :: fire_emis_factors_file = ' ' - logical :: fire_emis_elevated = .true. - integer :: i, tmp(1) + ! local variables + type(ESMF_VM) :: vm + integer :: localPet + integer :: rc + integer :: unitn ! namelist unit number + integer :: ierr ! error code + logical :: exists ! if file exists or not + integer, parameter :: maxspc = 100 + character(len=2*CX) :: fire_emis_specifier(maxspc) = ' ' + character(len=CL) :: fire_emis_factors_file = ' ' + logical :: fire_emis_elevated = .true. + integer :: i, tmp(1) character(*),parameter :: F00 = "('(shr_fire_emis_readnl) ',2a)" + !------------------------------------------------------------------ namelist /fire_emis_nl/ fire_emis_specifier, fire_emis_factors_file, fire_emis_elevated @@ -157,25 +162,30 @@ subroutine shr_fire_emis_readnl( NLFileName, emis_fields, emis_nflds ) shr_fire_emis_elevated = fire_emis_elevated ! parse the namelist info and initialize the module data - call shr_fire_emis_init( fire_emis_specifier, emis_fields ) + call shr_fire_emis_init( fire_emis_specifier ) end subroutine shr_fire_emis_readnl - !----------------------------------------------------------------------- - ! module data initializer - !------------------------------------------------------------------------ - subroutine shr_fire_emis_init( specifier, emis_fields ) +!------------------------------------------------------------------------- +! private methods... +!------------------------------------------------------------------------- + + subroutine shr_fire_emis_init( specifier ) + + !-------------------------------------------------- + ! module data initializer + !-------------------------------------------------- use shr_expr_parser_mod, only : shr_exp_parse, shr_exp_item_t, shr_exp_list_destroy + ! input/output variables character(len=*), intent(in) :: specifier(:) - character(len=*), intent(out) :: emis_fields + ! local variables integer :: n_entries integer :: i, j, k - type(shr_exp_item_t), pointer :: items_list, item - character(len=12) :: token ! fire emis field name to add + !------------------------------------------------------ nullify(shr_fire_emis_linkedlist) @@ -184,8 +194,6 @@ subroutine shr_fire_emis_init( specifier, emis_fields ) allocate(shr_fire_emis_mechcomps(n_entries)) shr_fire_emis_mechcomps(:)%n_emis_comps = 0 - emis_fields = '' - item => items_list i = 1 do while(associated(item)) @@ -208,32 +216,17 @@ subroutine shr_fire_emis_init( specifier, emis_fields ) enddo shr_fire_emis_mechcomps_n = shr_fire_emis_mechcomps_n+1 - write(token,333) shr_fire_emis_mechcomps_n - - if ( shr_fire_emis_mechcomps_n == 1 ) then - ! do not prepend ":" to the string for the first token - emis_fields = trim(token) - shr_fire_emis_fields_token = token - else - emis_fields = trim(emis_fields)//':'//trim(token) - endif - item => item%next_item i = i+1 enddo if (associated(items_list)) call shr_exp_list_destroy(items_list) ! Need to explicitly add Fl_ based on naming convention -333 format ('Fall_fire',i3.3) end subroutine shr_fire_emis_init !------------------------------------------------------------------------- - ! private methods... - - !------------------------------------------------------------------------- - !------------------------------------------------------------------------- function add_emis_comp( name, coeff ) result(emis_comp) character(len=*), intent(in) :: name @@ -263,7 +256,7 @@ function add_emis_comp( name, coeff ) result(emis_comp) end function add_emis_comp !------------------------------------------------------------------------- - !------------------------------------------------------------------------- + recursive function get_emis_comp_by_name(list_comp, name) result(emis_comp) type(shr_fire_emis_comp_t), pointer :: list_comp @@ -283,7 +276,7 @@ recursive function get_emis_comp_by_name(list_comp, name) result(emis_comp) end function get_emis_comp_by_name !------------------------------------------------------------------------- - !------------------------------------------------------------------------- + subroutine add_emis_comp_to_list( new_emis_comp ) type(shr_fire_emis_comp_t), target, intent(in) :: new_emis_comp diff --git a/src/drivers/nuopc/cime_flds_shr/shr_megan_mod.F90 b/src/drivers/nuopc/cime_flds_shr/shr_megan_mod.F90 index 659719f01bb6..545d6cc74337 100644 --- a/src/drivers/nuopc/cime_flds_shr/shr_megan_mod.F90 +++ b/src/drivers/nuopc/cime_flds_shr/shr_megan_mod.F90 @@ -1,17 +1,19 @@ -!================================================================================ -! Handles MEGAN VOC emissions metadata for CLM produced chemical emissions -! MEGAN = Model of Emissions of Gases and Aerosols from Nature -! -! This reads the megan_emis_nl namelist in drv_flds_in and makes the relavent -! information available to CAM, CLM, and driver. The driver sets up CLM to CAM -! communication for the VOC flux fields. CLM needs to know what specific VOC -! fluxes need to be passed to the coupler and how to assimble the fluxes. -! CAM needs to know what specific VOC fluxes to expect from CLM. -! -! Francis Vitt -- 26 Oct 2011 -!================================================================================ module shr_megan_mod + !================================================================================ + ! Handles MEGAN VOC emissions metadata for CLM produced chemical emissions + ! MEGAN = Model of Emissions of Gases and Aerosols from Nature + ! + ! This reads the megan_emis_nl namelist in drv_flds_in and makes the relavent + ! information available to CAM, CLM, and driver. + ! - The driver sets up CLM to CAM communication for the VOC flux fields. + ! - CLM needs to know what specific VOC fluxes need to be passed to the coupler + ! and how to assemble the fluxes. + ! - CAM needs to know what specific VOC fluxes to expect from CLM. + ! + ! Francis Vitt -- 26 Oct 2011 + !================================================================================ + use shr_kind_mod,only : r8 => shr_kind_r8 use shr_kind_mod,only : CL => SHR_KIND_CL, CX => SHR_KIND_CX, CS => SHR_KIND_CS use shr_sys_mod, only : shr_sys_abort @@ -19,7 +21,6 @@ module shr_megan_mod use shr_log_mod, only : logunit => shr_log_Unit implicit none - save private public :: shr_megan_readnl ! reads megan_emis_nl namelist @@ -33,9 +34,7 @@ module shr_megan_mod public :: shr_megan_comp_ptr logical , public :: megan_initialized = .false. ! true => shr_megan_readnl alreay called - character(len=CS), public :: shr_megan_fields_token = '' ! First drydep fields token character(len=CL), public :: shr_megan_factors_file = '' - character(len=CX), public :: shr_megan_fields = '' ! MEGAN compound data structure (or user defined type) type shr_megan_megcomp_t @@ -68,105 +67,108 @@ module shr_megan_mod ! switch to use mapped emission factors logical :: shr_megan_mapped_emisfctrs = .false. +!-------------------------------------------------------- contains - - !------------------------------------------------------------------------- - ! - ! This reads the megan_emis_nl namelist group in drv_flds_in and parses the - ! namelist information for the driver, CLM, and CAM. - ! - ! Namelist variables: - ! megan_specifier, megan_mapped_emisfctrs, megan_factors_file - ! - ! megan_specifier is a series of strings where each string contains one - ! CAM chemistry constituent name (left of = sign) and one or more MEGAN - ! compound (separated by + sign if more than one). Each MEGAN compound - ! can be proceeded by a multiplication factor (separated by *). The - ! specification of the MEGAN compounds to the right of the = signs tells - ! the MEGAN VOC model within CLM how to construct the VOC fluxes using - ! the factors in megan_factors_file and land surface state. - ! - ! megan_factors_file read by CLM contains valid MEGAN compound names, - ! MEGAN class groupings and scalar emission factors - ! - ! megan_mapped_emisfctrs switch is used to tell the MEGAN model to use - ! mapped emission factors read in from the CLM surface data input file - ! rather than the scalar factors from megan_factors_file - ! - ! Example: - ! &megan_emis_nl - ! megan_specifier = 'ISOP = isoprene', - ! 'C10H16 = myrcene + sabinene + limonene + carene_3 + ocimene_t_b + pinene_b + ...', - ! 'CH3OH = methanol', - ! 'C2H5OH = ethanol', - ! 'CH2O = formaldehyde', - ! 'CH3CHO = acetaldehyde', - ! ... - ! megan_factors_file = '$datapath/megan_emis_factors.nc' - ! / - !------------------------------------------------------------------------- - subroutine shr_megan_readnl( NLFileName, megan_fields, megan_nflds ) - use ESMF, only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMBroadcast, ESMF_VMGet - use shr_nl_mod, only : shr_nl_find_group_name - use shr_file_mod, only : shr_file_getUnit, shr_file_freeUnit - +!-------------------------------------------------------- + + subroutine shr_megan_readnl( NLFileName, megan_nflds) + + !------------------------------------------------------------------------- + ! + ! This reads the megan_emis_nl namelist group in drv_flds_in and parses the + ! namelist information for the driver, CLM, and CAM. + ! + ! Namelist variables: + ! megan_specifier, megan_mapped_emisfctrs, megan_factors_file + ! + ! megan_specifier is a series of strings where each string contains one + ! CAM chemistry constituent name (left of = sign) and one or more MEGAN + ! compound (separated by + sign if more than one). Each MEGAN compound + ! can be proceeded by a multiplication factor (separated by *). The + ! specification of the MEGAN compounds to the right of the = signs tells + ! the MEGAN VOC model within CLM how to construct the VOC fluxes using + ! the factors in megan_factors_file and land surface state. + ! + ! megan_factors_file read by CLM contains valid MEGAN compound names, + ! MEGAN class groupings and scalar emission factors + ! + ! megan_mapped_emisfctrs switch is used to tell the MEGAN model to use + ! mapped emission factors read in from the CLM surface data input file + ! rather than the scalar factors from megan_factors_file + ! + ! Example: + ! &megan_emis_nl + ! megan_specifier = 'ISOP = isoprene', + ! 'C10H16 = myrcene + sabinene + limonene + carene_3 + ocimene_t_b + pinene_b + ...', + ! 'CH3OH = methanol', + ! 'C2H5OH = ethanol', + ! 'CH2O = formaldehyde', + ! 'CH3CHO = acetaldehyde', + ! ... + ! megan_factors_file = '$datapath/megan_emis_factors.nc' + ! / + !------------------------------------------------------------------------- + + use ESMF , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMBroadcast, ESMF_VMGet + use shr_nl_mod , only : shr_nl_find_group_name + use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit + + ! input/output variables character(len=*), intent(in) :: NLFileName - character(len=*), intent(out) :: megan_fields integer, intent(out) :: megan_nflds - type(ESMF_VM) :: vm - integer :: localPet - integer :: unitn ! namelist unit number - integer :: ierr ! error code - logical :: exists ! if file exists or not + ! local variables + type(ESMF_VM) :: vm + integer :: localPet + integer :: unitn ! namelist unit number + integer :: ierr ! error code + logical :: exists ! if file exists or not integer, parameter :: maxspc = 100 character(len=2*CX) :: megan_specifier(maxspc) = ' ' logical :: megan_mapped_emisfctrs = .false. character(len=CL) :: megan_factors_file = ' ' - integer :: rc - integer :: i, tmp(1) + integer :: rc + integer :: i, tmp(1) character(*),parameter :: F00 = "('(shr_megan_readnl) ',2a)" + !-------------------------------------------------------------- namelist /megan_emis_nl/ megan_specifier, megan_factors_file, megan_mapped_emisfctrs ! If other processes have already initialized megan - then just return ! the megan_fields that have already been set if (megan_initialized) then - megan_fields = trim(shr_megan_fields) megan_nflds = shr_megan_mechcomps_n return end if + call ESMF_VMGetCurrent(vm, rc=rc) call ESMF_VMGet(vm, localpet=localpet, rc=rc) megan_nflds = 0 + if (localPet==0) then inquire( file=trim(NLFileName), exist=exists) if ( exists ) then unitn = shr_file_getUnit() open( unitn, file=trim(NLFilename), status='old' ) - if ( loglev > 0 ) write(logunit,F00) & - 'Read in megan_emis_readnl namelist from: ', trim(NLFilename) - + write(logunit,F00) 'Read in megan_emis_readnl namelist from: ', trim(NLFilename) call shr_nl_find_group_name(unitn, 'megan_emis_nl', status=ierr) - ! If ierr /= 0, no namelist present. - if (ierr == 0) then - read(unitn, megan_emis_nl, iostat=ierr) - + ! Note that ierr /= 0, no namelist is present. + read (unitn, megan_emis_nl, iostat=ierr) if (ierr > 0) then call shr_sys_abort( 'problem on read of megan_emis_nl namelist in shr_megan_readnl' ) endif endif - close( unitn ) call shr_file_freeUnit( unitn ) do i=1,maxspc - if(len_trim(megan_specifier(i)) > 0) then + if (len_trim(megan_specifier(i)) > 0) then megan_nflds=megan_nflds+1 endif enddo end if end if + tmp = megan_nflds call ESMF_VMBroadcast(vm, tmp, 1, 0, rc=rc) megan_nflds = tmp(1) @@ -174,33 +176,39 @@ subroutine shr_megan_readnl( NLFileName, megan_fields, megan_nflds ) call ESMF_VMBroadcast(vm, megan_specifier, 2*CX*megan_nflds, 0, rc=rc) call ESMF_VMBroadcast(vm, megan_factors_file, CL, 0, rc=rc) tmp = 0 - if(megan_mapped_emisfctrs) tmp=1 + if (megan_mapped_emisfctrs) tmp=1 call ESMF_VMBroadcast(vm, tmp, 1, 0, rc=rc) - if(tmp(1)==1) megan_mapped_emisfctrs=.true. + if (tmp(1)==1) megan_mapped_emisfctrs=.true. endif shr_megan_factors_file = megan_factors_file shr_megan_mapped_emisfctrs = megan_mapped_emisfctrs ! parse the namelist info and initialize the module data - call shr_megan_init( megan_specifier, megan_fields ) + call shr_megan_init( megan_specifier ) + end subroutine shr_megan_readnl - !------------------------------------------------------------------------- - ! module data initializer - !------------------------------------------------------------------------- - subroutine shr_megan_init( specifier, megan_fields ) +!------------------------------------------------------------------------- +! private methods... +!------------------------------------------------------------------------- + + subroutine shr_megan_init( specifier) + + !----------------------------------------- + ! Initialize module data + !----------------------------------------- use shr_expr_parser_mod, only : shr_exp_parse, shr_exp_item_t, shr_exp_list_destroy + ! input/output variables character(len=*), intent(in) :: specifier(:) - character(len=*), intent(out) :: megan_fields - - integer :: n_entries - integer :: i, j, k + ! local variables + integer :: n_entries + integer :: i, j, k type(shr_exp_item_t), pointer :: items_list, item - character(len=12) :: token ! megan field name to add + !-------------------------------------------------------------- nullify(shr_megan_linkedlist) @@ -209,8 +217,6 @@ subroutine shr_megan_init( specifier, megan_fields ) allocate(shr_megan_mechcomps(n_entries)) shr_megan_mechcomps(:)%n_megan_comps = 0 - megan_fields = '' - item => items_list i = 1 do while(associated(item)) @@ -233,34 +239,18 @@ subroutine shr_megan_init( specifier, megan_fields ) enddo shr_megan_mechcomps_n = shr_megan_mechcomps_n+1 - write(token,333) shr_megan_mechcomps_n - - if ( shr_megan_mechcomps_n == 1 ) then - ! do not prepend ":" to the string for the first token - megan_fields = trim(token) - shr_megan_fields_token = token - else - megan_fields = trim(megan_fields)//':'//trim(token) - endif - item => item%next_item i = i+1 + enddo if (associated(items_list)) call shr_exp_list_destroy(items_list) megan_initialized = .true. - shr_megan_fields = trim(megan_fields) - - ! Need to explicitly add Fl_ based on naming convention -333 format ('Fall_voc',i3.3) end subroutine shr_megan_init !------------------------------------------------------------------------- - ! private methods... - !------------------------------------------------------------------------- - !------------------------------------------------------------------------- function add_megan_comp( name, coeff ) result(megan_comp) character(len=16), intent(in) :: name @@ -290,7 +280,7 @@ function add_megan_comp( name, coeff ) result(megan_comp) end function add_megan_comp !------------------------------------------------------------------------- - !------------------------------------------------------------------------- + recursive function get_megan_comp_by_name(list_comp, name) result(megan_comp) type(shr_megan_megcomp_t), pointer :: list_comp @@ -310,7 +300,7 @@ recursive function get_megan_comp_by_name(list_comp, name) result(megan_comp) end function get_megan_comp_by_name !------------------------------------------------------------------------- - !------------------------------------------------------------------------- + subroutine add_megan_comp_to_list( new_megan_comp ) type(shr_megan_megcomp_t), target, intent(in) :: new_megan_comp diff --git a/src/drivers/nuopc/cime_flds_shr/shr_ndep_mod.F90 b/src/drivers/nuopc/cime_flds_shr/shr_ndep_mod.F90 index c48e02356515..65605c98a7a1 100644 --- a/src/drivers/nuopc/cime_flds_shr/shr_ndep_mod.F90 +++ b/src/drivers/nuopc/cime_flds_shr/shr_ndep_mod.F90 @@ -22,40 +22,37 @@ module shr_ndep_mod CONTAINS !==================================================================================== - subroutine shr_ndep_readnl(NLFilename, ndep_fields, ndep_nflds) + subroutine shr_ndep_readnl(NLFilename, ndep_nflds) !======================================================================== ! reads ndep_inparm namelist and sets up driver list of fields for ! atmosphere -> land and atmosphere -> ocn communications. !======================================================================== - use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit - use shr_nl_mod , only : shr_nl_find_group_name - use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMBroadcast, ESMF_VMGet + use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit + use shr_nl_mod , only : shr_nl_find_group_name + use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMBroadcast, ESMF_VMGet use shr_nuopc_utils_mod , only : shr_nuopc_utils_chkerr - implicit none - + ! input/output variables character(len=*), intent(in) :: NLFilename ! Namelist filename - character(len=*), intent(out) :: ndep_fields integer , intent(out) :: ndep_nflds !----- local ----- - type(ESMF_VM) :: vm - integer :: i ! Indices - integer :: unitn ! namelist unit number - integer :: ierr ! error code - integer :: tmp(1) - logical :: exists ! if file exists or not - character(len=8) :: token ! dry dep field name to add - integer :: rc - integer, parameter :: maxspc = 100 ! Maximum number of species - character(len=32) :: ndep_list(maxspc) = '' ! List of ndep species - integer :: localpet - !----- formats ----- + type(ESMF_VM) :: vm + integer :: i ! Indices + integer :: unitn ! namelist unit number + integer :: ierr ! error code + integer :: tmp(1) + logical :: exists ! if file exists or not + integer :: rc + integer, parameter :: maxspc = 100 ! Maximum number of species + character(len=32) :: ndep_list(maxspc) = '' ! List of ndep species + integer :: localpet character(*),parameter :: subName = '(shr_ndep_read) ' character(*),parameter :: F00 = "('(shr_ndep_read) ',8a)" character(*),parameter :: FI1 = "('(shr_ndep_init) ',a,I2)" + ! ------------------------------------------------------------------ namelist /ndep_inparm/ ndep_list @@ -107,22 +104,6 @@ subroutine shr_ndep_readnl(NLFilename, ndep_fields, ndep_nflds) ndep_nflds=tmp(1) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - ndep_fields = ' ' - - if(ndep_nflds > 0) then - call ESMF_VMBroadcast(vm, ndep_list, 32*ndep_nflds, 0, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - ! Loop over species to fill list of fields to communicate for ndep - do i=1,ndep_nflds - if ( len_trim(ndep_list(i))==0 ) exit - if ( i == 1 ) then - ndep_fields = 'Faxa_' // trim(ndep_list(i)) - else - ndep_fields = trim(ndep_fields)//':'//'Faxa_' // trim(ndep_list(i)) - endif - enddo - end if - end subroutine shr_ndep_readnl end module shr_ndep_mod diff --git a/src/drivers/nuopc/mediator/med.F90 b/src/drivers/nuopc/mediator/med.F90 index 623b66a6133a..631c5153ab36 100644 --- a/src/drivers/nuopc/mediator/med.F90 +++ b/src/drivers/nuopc/mediator/med.F90 @@ -48,20 +48,6 @@ subroutine SetServices(gcomp, rc) use NUOPC_Mediator , only: mediator_label_Finalize => label_Finalize use med_phases_history_mod , only: med_phases_history_write use med_phases_restart_mod , only: med_phases_restart_write - use med_connectors_mod , only: med_connectors_prep_med2atm - use med_connectors_mod , only: med_connectors_prep_med2ocn - use med_connectors_mod , only: med_connectors_prep_med2ice - use med_connectors_mod , only: med_connectors_prep_med2lnd - use med_connectors_mod , only: med_connectors_prep_med2rof - use med_connectors_mod , only: med_connectors_prep_med2wav - use med_connectors_mod , only: med_connectors_prep_med2glc - use med_connectors_mod , only: med_connectors_post_atm2med - use med_connectors_mod , only: med_connectors_post_ocn2med - use med_connectors_mod , only: med_connectors_post_ice2med - use med_connectors_mod , only: med_connectors_post_lnd2med - use med_connectors_mod , only: med_connectors_post_rof2med - use med_connectors_mod , only: med_connectors_post_wav2med - use med_connectors_mod , only: med_connectors_post_glc2med use med_phases_prep_atm_mod , only: med_phases_prep_atm use med_phases_prep_ice_mod , only: med_phases_prep_ice use med_phases_prep_lnd_mod , only: med_phases_prep_lnd @@ -177,110 +163,6 @@ subroutine SetServices(gcomp, rc) specPhaseLabel="med_phases_profile", specRoutine=med_phases_profile, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - !------------------ - ! prep and post phases for connectors - !------------------ - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_prep_med2atm"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_prep_med2atm", specRoutine=med_connectors_prep_med2atm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_post_atm2med"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_post_atm2med", specRoutine=med_connectors_post_atm2med, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_prep_med2ocn"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_prep_med2ocn", specRoutine=med_connectors_prep_med2ocn, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_post_ocn2med"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_post_ocn2med", specRoutine=med_connectors_post_ocn2med, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_prep_med2ice"/), & - userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_prep_med2ice", specRoutine=med_connectors_prep_med2ice, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_post_ice2med"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_post_ice2med", specRoutine=med_connectors_post_ice2med, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_prep_med2lnd"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_prep_med2lnd", specRoutine=med_connectors_prep_med2lnd, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_post_lnd2med"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_post_lnd2med", specRoutine=med_connectors_post_lnd2med, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_prep_med2rof"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_prep_med2rof", specRoutine=med_connectors_prep_med2rof, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_post_rof2med"/), & - userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_post_rof2med", specRoutine=med_connectors_post_rof2med, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_prep_med2wav"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_prep_med2wav", specRoutine=med_connectors_prep_med2wav, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_post_wav2med"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_post_wav2med", specRoutine=med_connectors_post_wav2med, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_prep_med2glc"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_prep_med2glc", specRoutine=med_connectors_prep_med2glc, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_post_glc2med"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_post_glc2med", specRoutine=med_connectors_post_glc2med, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - !------------------ ! prep routines for atm !------------------ @@ -453,8 +335,9 @@ end subroutine SetServices !----------------------------------------------------------------------------- subroutine InitializeP0(gcomp, importState, exportState, clock, rc) + use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_VM, ESMF_SUCCESS - use ESMF , only : ESMF_UtilString2Int, ESMF_GridCompGet, ESMF_VMGet, ESMF_AttributeGet + use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_AttributeGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_METHOD_INITIALIZE use ESMF , only : ESMF_GridCompGet use NUOPC , only : NUOPC_CompFilterPhaseMap @@ -467,11 +350,10 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) ! local variables type(ESMF_VM) :: vm - character(len=*),parameter :: subname='(module_MED:InitializeP0)' - character(len=128) :: value - integer :: dbrc + character(len=128) :: value integer :: localPet - character(len=CX):: msgString + character(len=CX) :: msgString + character(len=*),parameter :: subname='(module_MED:InitializeP0)' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -486,21 +368,17 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) convention="NUOPC", purpose="Instance", rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//": Mediator verbosity is "//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) - -! dbug_flag = ESMF_UtilString2Int(value, & -! specialStringList=(/"min","max","high"/), specialValueList=(/0,255,255/), rc=rc) -! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": Mediator verbosity is "//trim(value), ESMF_LOGMSG_INFO) write(msgString,'(A,i6)') trim(subname)//' dbug_flag = ',dbug_flag - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) ! Switch to IPDv03 by filtering all other phaseMap entries call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, acceptStringList=(/"IPDv03p"/), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine InitializeP0 @@ -535,12 +413,11 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) integer :: n, n1, n2, ncomp, nflds character(len=CS) :: transferOffer type(InternalState) :: is_local - integer :: dbrc integer :: stat character(len=*),parameter :: subname='(module_MED:InitializeIPDv03p1)' !----------------------------------------------------------- - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS !------------------ @@ -632,13 +509,14 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) call NUOPC_Advertise(is_local%wrap%NStateExp(ncomp), standardName=stdname, shortname=shortname, name=shortname, & TransferOfferGeomObject=transferOffer) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//':To_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end do end if end do ! end of ncomps loop - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine InitializeIPDv03p1 @@ -665,35 +543,24 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! local variables - integer :: i, j - real(kind=R8),pointer :: lonPtr(:), latPtr(:) type(InternalState) :: is_local - real(R8) :: intervalSec - type(ESMF_TimeInterval) :: timeStep - ! tcx XGrid - ! type(ESMF_Field) :: fieldX, fieldA, fieldO - ! type(ESMF_XGrid) :: xgrid type(ESMF_VM) :: vm - integer :: n, n1, n2 - character(CL) :: cvalue - logical :: connected - integer :: dbrc - integer :: stat + integer :: n character(len=*),parameter :: subname='(module_MED:InitializeIPDv03p3)' !----------------------------------------------------------- - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS ! Get the internal state from Component. nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! Initialize the internal state members - is_local%wrap%vm = vm + ! Initialize the internal state mediator vm + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + is_local%wrap%vm = vm ! Realize States do n = 1,ncomps @@ -709,7 +576,7 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) endif enddo - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine InitializeIPDv03p3 @@ -744,11 +611,10 @@ subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) ! integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) ! integer, allocatable :: regDecompPTile(:,:) ! integer :: i, j, n, n1 - integer :: dbrc character(len=*),parameter :: subname='(module_MED:realizeConnectedGrid)' !----------------------------------------------------------- - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS ! Get the internal state from the mediator gridded component. @@ -761,7 +627,7 @@ subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) !------------------ do n1 = 1,ncomps - call ESMF_LogWrite(trim(subname)//": calling for component "//trim(compname(n1)), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": calling for component "//trim(compname(n1)), ESMF_LOGMSG_INFO) if (ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then call realizeConnectedGrid(is_local%wrap%NStateImp(n1), trim(compname(n1))//'Imp', rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -770,9 +636,9 @@ subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) call realizeConnectedGrid(is_local%wrap%NStateExp(n1), trim(compname(n1))//'Exp', rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return endif - call ESMF_LogWrite(trim(subname)//": finished for component "//trim(compname(n1)), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": finished for component "//trim(compname(n1)), ESMF_LOGMSG_INFO) enddo - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -813,10 +679,9 @@ subroutine realizeConnectedGrid(State,string,rc) type(ESMF_GeomType_Flag) :: geomtype character(ESMF_MAXSTR),allocatable :: fieldNameList(:) type(ESMF_FieldStatus_Flag) :: fieldStatus - integer :: dbrc character(len=CX) :: msgString character(len=*),parameter :: subname='(module_MEDIATOR:realizeConnectedGrid)' - + !----------------------------------------------------------- !NOTE: All of the Fields that set their TransferOfferGeomObject Attribute !NOTE: to "cannot provide" should now have the accepted Grid available. @@ -827,7 +692,7 @@ subroutine realizeConnectedGrid(State,string,rc) !TODO: quick implementation, do it for each field one by one !TODO: commented out below are application to other fields - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_Success call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) @@ -877,9 +742,9 @@ subroutine realizeConnectedGrid(State,string,rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//": geomtype is ESMF_GEOMTYPE_GRID for "//trim(fieldnameList(n)), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) write(msgString,'(A,i8)') trim(subname)//':arbdimcount =',arbdimcount - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) ! make decision on whether the incoming Grid is arbDistr or not if (arbDimCount>0) then @@ -897,7 +762,7 @@ subroutine realizeConnectedGrid(State,string,rc) if (grid_arbopt == "grid_reg") then call ESMF_LogWrite(trim(subname)//trim(string)//": accept arb2reg grid for "//trim(fieldNameList(n)), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) ! Use a regDecomp representation for the grid ! first get tile min/max, only single tile supported for arbDistr Grid @@ -939,7 +804,7 @@ subroutine realizeConnectedGrid(State,string,rc) ! redistribute the arbSeqIndexList. Here simply keep the DEs of the ! provider Grid. call ESMF_LogWrite(trim(subname)//trim(string)//": accept arb2arb grid for "//trim(fieldNameList(n)), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) else ! grid_arbopt @@ -957,7 +822,7 @@ subroutine realizeConnectedGrid(State,string,rc) ! access localDeCount to show this is a real Grid call ESMF_LogWrite(trim(subname)//trim(string)//": accept reg2reg grid for "//& - trim(fieldNameList(n)), ESMF_LOGMSG_INFO, rc=dbrc) + trim(fieldNameList(n)), ESMF_LOGMSG_INFO) call ESMF_FieldGet(field, grid=grid, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1003,7 +868,7 @@ subroutine realizeConnectedGrid(State,string,rc) do i1 = 1,dimCount write(msgString,'(A,5i8)') trim(subname)//':PTile =',i2,i1,minIndexPTile(i1,i2),& maxIndexPTile(i1,i2),regDecompPTile(i1,i2) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) enddo enddo @@ -1085,7 +950,7 @@ subroutine realizeConnectedGrid(State,string,rc) elseif (geomtype == ESMF_GEOMTYPE_MESH) then call ESMF_LogWrite(trim(subname)//": geomtype is ESMF_GEOMTYPE_MESH for "//trim(fieldnameList(n)), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) if (dbug_flag > 1) then call shr_nuopc_methods_Field_GeomPrint(field,trim(fieldNameList(n))//'_orig',rc) @@ -1153,12 +1018,12 @@ subroutine realizeConnectedGrid(State,string,rc) elseif (fieldStatus==ESMF_FIELDSTATUS_EMPTY) then call ESMF_LogWrite(trim(subname)//trim(string)//": provide grid for "//trim(fieldNameList(n)), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) elseif (fieldStatus==ESMF_FIELDSTATUS_COMPLETE) then call ESMF_LogWrite(trim(subname)//trim(string)//": no grid provided for "//trim(fieldNameList(n)), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) else @@ -1172,7 +1037,7 @@ subroutine realizeConnectedGrid(State,string,rc) deallocate(fieldNameList) - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine realizeConnectedGrid @@ -1203,10 +1068,9 @@ subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) type(InternalState) :: is_local integer :: n1,n2 character(len=*),parameter :: subname='(module_MED:InitializeIPDv03p5)' - integer :: dbrc !----------------------------------------------------------- - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS @@ -1222,7 +1086,7 @@ subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) if (ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then call ESMF_LogWrite(trim(subname)//": calling completeFieldInitialize import states from "//trim(compname(n1)), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) call completeFieldInitialization(is_local%wrap%NStateImp(n1), rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1232,7 +1096,7 @@ subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) if (ESMF_StateIsCreated(is_local%wrap%NStateExp(n1),rc=rc)) then call ESMF_LogWrite(trim(subname)//": calling completeFieldInitialize export states to "//trim(compname(n1)), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) call completeFieldInitialization(is_local%wrap%NStateExp(n1), rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1249,7 +1113,7 @@ subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) endif enddo - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -1260,6 +1124,7 @@ subroutine completeFieldInitialization(State,rc) use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FieldGet, ESMF_FieldEmptyComplete use ESMF , only : ESMF_GeomType_Flag, ESMF_FieldCreate, ESMF_GridToMeshCell, ESMF_GEOMTYPE_GRID use ESMF , only : ESMF_MeshLoc_Element, ESMF_TYPEKIND_R8, ESMF_FIELDSTATUS_GRIDSET + use ESMF , only : ESMF_AttributeGet use NUOPC , only : NUOPC_getStateMemberLists, NUOPC_Realize use shr_nuopc_scalars_mod , only : flds_scalar_name, flds_scalar_num use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_getNumFields @@ -1278,9 +1143,14 @@ subroutine completeFieldInitialization(State,rc) type(ESMF_Field),pointer :: fieldList(:) type(ESMF_FieldStatus_Flag) :: fieldStatus type(ESMF_GeomType_Flag) :: geomtype + integer :: gridToFieldMapCount, ungriddedCount + integer, allocatable :: gridToFieldMap(:) + integer, allocatable :: ungriddedLBound(:), ungriddedUBound(:) + logical :: isPresent character(len=*),parameter :: subname='(module_MED:completeFieldInitialization)' + !----------------------------------------------------------- - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_Success call shr_nuopc_methods_State_GetNumFields(State, fieldCount, rc=rc) @@ -1310,7 +1180,8 @@ subroutine completeFieldInitialization(State,rc) mesh = ESMF_GridToMeshCell(grid,rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - meshField = ESMF_FieldCreate(mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, name=fieldName, rc=rc) + meshField = ESMF_FieldCreate(mesh, typekind=ESMF_TYPEKIND_R8, & + meshloc=ESMF_MESHLOC_ELEMENT, name=fieldName, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! Swap grid for mesh, at this point, only connected fields are in the state @@ -1321,20 +1192,42 @@ subroutine completeFieldInitialization(State,rc) if (fieldStatus==ESMF_FIELDSTATUS_GRIDSET) then call ESMF_LogWrite(subname//" is allocating field memory for field "//trim(fieldName), & ESMF_LOGMSG_INFO, rc=rc) - call ESMF_FieldEmptyComplete(fieldList(n), typekind=ESMF_TYPEKIND_R8, rc=rc) + + call ESMF_AttributeGet(fieldList(n), name="GridToFieldMap", convention="NUOPC", & + purpose="Instance", itemCount=gridToFieldMapCount, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(gridToFieldMap(gridToFieldMapCount)) + call ESMF_AttributeGet(fieldList(n), name="GridToFieldMap", convention="NUOPC", & + purpose="Instance", valueList=gridToFieldMap, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ungriddedCount=0 ! initialize in case it was not set + call ESMF_AttributeGet(fieldList(n), name="UngriddedLBound", convention="NUOPC", & + purpose="Instance", itemCount=ungriddedCount, isPresent=isPresent, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(ungriddedLBound(ungriddedCount), ungriddedUBound(ungriddedCount)) + + if (ungriddedCount > 0) then + call ESMF_AttributeGet(fieldList(n), name="UngriddedLBound", convention="NUOPC", & + purpose="Instance", valueList=ungriddedLBound, rc=rc) + call ESMF_AttributeGet(fieldList(n), name="UngriddedUBound", convention="NUOPC", & + purpose="Instance", valueList=ungriddedUBound, rc=rc) + endif + + call ESMF_FieldEmptyComplete(fieldList(n), typekind=ESMF_TYPEKIND_R8, gridToFieldMap=gridToFieldMap, & + ungriddedLbound=ungriddedLbound, ungriddedUbound=ungriddedUbound, rc=rc) + + deallocate(gridToFieldMap, ungriddedLbound, ungriddedUbound) endif ! fieldStatus - if (dbug_flag > 1) then - call shr_nuopc_methods_Field_GeomPrint(fieldList(n), trim(subname)//':'//trim(fieldName), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if + call shr_nuopc_methods_Field_GeomPrint(fieldList(n), trim(subname)//':'//trim(fieldName), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return enddo deallocate(fieldList) endif - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine completeFieldInitialization @@ -1343,6 +1236,7 @@ end subroutine InitializeIPDv03p5 !----------------------------------------------------------------------------- subroutine DataInitialize(gcomp, rc) + !---------------------------------------------------------- ! Finish initialization and resolve data dependencies ! There will be multiple passes @@ -1350,10 +1244,9 @@ subroutine DataInitialize(gcomp, rc) ! Do not assume any import fields are connected, just allocate space and such ! -- Check present flags ! -- Check for active coupling interactions - ! -- Initialize connector count arrays in med_internal_state ! -- Create FBs: FBImp, FBExp, FBExpAccum ! -- Create mediator specific field bundles (not part of import/export states) - ! -- Initialize med_infodata, FBExpAccums (to zero), and FBImp (from NStateImp) + ! -- Initialize FBExpAccums (to zero), and FBImp (from NStateImp) ! -- Read mediator restarts ! -- Initialize route handles ! -- Initialize field bundles for normalization @@ -1373,7 +1266,8 @@ subroutine DataInitialize(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_LogWrite, ESMF_LOGMSG_INFO use ESMF , only : ESMF_State, ESMF_Time, ESMF_Field, ESMF_StateItem_Flag, ESMF_MAXSTR use ESMF , only : ESMF_GridCompGet, ESMF_AttributeGet, ESMF_ClockGet, ESMF_Success - use ESMF , only : ESMF_StateIsCreated, ESMF_StateGet, ESMF_LogFlush + use ESMF , only : ESMF_StateIsCreated, ESMF_StateGet, ESMF_FieldBundleIsCreated, ESMF_LogFlush + use ESMF , only : ESMF_VM use NUOPC , only : NUOPC_CompAttributeSet, NUOPC_IsAtTime, NUOPC_SetAttribute use NUOPC , only : NUOPC_CompAttributeGet use med_internalstate_mod , only : InternalState @@ -1389,33 +1283,20 @@ subroutine DataInitialize(gcomp, rc) use esmFlds , only : shr_nuopc_fldList_Document_Merging use esmFldsExchange_mod , only : esmFldsExchange use shr_nuopc_scalars_mod , only : flds_scalar_name, flds_scalar_num + use shr_nuopc_scalars_mod , only : flds_scalar_index_nx, flds_scalar_index_ny use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_getNumFields use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_Init + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_Init_pointer use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_Reset use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_Copy use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FldChk - use med_infodata_mod , only : med_infodata_CopyStateToInfodata - use med_infodata_mod , only : med_infodata + use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_GetScalar use med_fraction_mod , only : med_fraction_init, med_fraction_set use med_phases_restart_mod , only : med_phases_restart_read use med_phases_prep_atm_mod , only : med_phases_prep_atm use med_phases_ocnalb_mod , only : med_phases_ocnalb_run use med_phases_aofluxes_mod , only : med_phases_aofluxes_run use med_phases_profile_mod , only : med_phases_profile - use med_connectors_mod , only : med_connectors_prep_med2atm - use med_connectors_mod , only : med_connectors_prep_med2ocn - use med_connectors_mod , only : med_connectors_prep_med2ice - use med_connectors_mod , only : med_connectors_prep_med2lnd - use med_connectors_mod , only : med_connectors_prep_med2rof - use med_connectors_mod , only : med_connectors_prep_med2wav - use med_connectors_mod , only : med_connectors_prep_med2glc - use med_connectors_mod , only : med_connectors_post_atm2med - use med_connectors_mod , only : med_connectors_post_ocn2med - use med_connectors_mod , only : med_connectors_post_ice2med - use med_connectors_mod , only : med_connectors_post_lnd2med - use med_connectors_mod , only : med_connectors_post_rof2med - use med_connectors_mod , only : med_connectors_post_wav2med - use med_connectors_mod , only : med_connectors_post_glc2med use med_map_mod , only : med_map_MapNorm_init, med_map_RouteHandles_init use med_io_mod , only : med_io_init @@ -1425,6 +1306,7 @@ subroutine DataInitialize(gcomp, rc) ! local variables type(InternalState) :: is_local + type(ESMF_VM) :: vm type(ESMF_Clock) :: clock type(ESMF_State) :: importState, exportState type(ESMF_Time) :: time @@ -1445,12 +1327,12 @@ subroutine DataInitialize(gcomp, rc) logical,save :: ocnDone = .false. logical,save :: allDone = .false. logical,save :: first_call = .true. - integer :: dbrc + real(r8) :: real_nx, real_ny character(len=CX) :: msgString character(len=*), parameter :: subname='(module_MED:DataInitialize)' !----------------------------------------------------------- - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) @@ -1491,7 +1373,7 @@ subroutine DataInitialize(gcomp, rc) is_local%wrap%comp_present(n1) = (value == "true") write(msgString,'(A,L4)') trim(subname)//' comp_present(comp'//trim(compname(n1))//') = ',& is_local%wrap%comp_present(n1) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) enddo !---------------------------------------------------------- @@ -1511,8 +1393,7 @@ subroutine DataInitialize(gcomp, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return if (cntn1 > 0) then do n2 = 1,ncomps - if (is_local%wrap%comp_present(n2) .and. & - ESMF_StateIsCreated(is_local%wrap%NStateExp(n2),rc=rc) .and. & + if (is_local%wrap%comp_present(n2) .and. ESMF_StateIsCreated(is_local%wrap%NStateExp(n2),rc=rc) .and. & med_coupling_allowed(n1,n2)) then call shr_nuopc_methods_State_GetNumFields(is_local%wrap%NStateExp(n2), cntn2, rc=rc) ! Import Field Count if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1566,9 +1447,6 @@ subroutine DataInitialize(gcomp, rc) call ESMF_LogWrite("Starting to Create FBs", ESMF_LOGMSG_INFO) call ESMF_LogFlush() - is_local%wrap%conn_prep_cnt(:) = 0 - is_local%wrap%conn_post_cnt(:) = 0 - !---------------------------------------------------------- ! Create field bundles FBImp, FBExp, FBImpAccum, FBExpAccum !---------------------------------------------------------- @@ -1580,30 +1458,28 @@ subroutine DataInitialize(gcomp, rc) if (mastertask) write(logunit,*) subname,' initializing FBs for '//trim(compname(n1)) - call shr_nuopc_methods_FB_init(is_local%wrap%FBImp(n1,n1), flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(n1), & - STflds=is_local%wrap%NStateImp(n1), & - name='FBImp'//trim(compname(n1)), rc=rc) + ! Create FBImp(:) with pointers directly into NStateImp(:) + call shr_nuopc_methods_FB_init_pointer(is_local%wrap%NStateImp(n1), is_local%wrap%FBImp(n1,n1), & + flds_scalar_name, name='FBImp'//trim(compname(n1)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create FBExp(:) with pointers directly into NStateExp(:) + call shr_nuopc_methods_FB_init_pointer(is_local%wrap%NStateExp(n1), is_local%wrap%FBExp(n1), & + flds_scalar_name, name='FBExp'//trim(compname(n1)), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! Create import accumulation field bundles call shr_nuopc_methods_FB_init(is_local%wrap%FBImpAccum(n1,n1), flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(n1), & - STflds=is_local%wrap%NStateImp(n1), & + STgeom=is_local%wrap%NStateImp(n1), STflds=is_local%wrap%NStateImp(n1), & name='FBImp'//trim(compname(n1)), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_FB_reset(is_local%wrap%FBImpAccum(n1,n1), value=czero, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return is_local%wrap%FBImpAccumCnt(n1) = 0 - call shr_nuopc_methods_FB_init(is_local%wrap%FBExp(n1), flds_scalar_name, & - STgeom=is_local%wrap%NStateExp(n1), & - STflds=is_local%wrap%NStateExp(n1), & - name='FBExp'//trim(compname(n1)), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - + ! Create export accumulation field bundles call shr_nuopc_methods_FB_init(is_local%wrap%FBExpAccum(n1), flds_scalar_name, & - STgeom=is_local%wrap%NStateExp(n1), & - STflds=is_local%wrap%NStateExp(n1), & + STgeom=is_local%wrap%NStateExp(n1), STflds=is_local%wrap%NStateExp(n1), & name='FBExpAccum'//trim(compname(n1)), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_FB_reset(is_local%wrap%FBExpAccum(n1), value=czero, rc=rc) @@ -1620,7 +1496,7 @@ subroutine DataInitialize(gcomp, rc) if (n1 /= n2 .and. & is_local%wrap%med_coupling_active(n1,n2) .and. & ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc) .and. & - ESMF_StateIsCreated(is_local%wrap%NStateExp(n2),rc=rc)) then + ESMF_StateIsCreated(is_local%wrap%NStateImp(n2),rc=rc)) then if (mastertask) write(logunit,*) subname,' initializing FBs for '//& trim(compname(n1))//'_'//trim(compname(n2)) @@ -1644,23 +1520,29 @@ subroutine DataInitialize(gcomp, rc) enddo ! loop over n2 enddo ! loop over n1 + if (mastertask) call shr_sys_flush(logunit) !--------------------------------------- ! Initialize field bundles needed for ocn albedo and ocn/atm flux calculations !--------------------------------------- + ! NOTE: the NStateImp(compocn) or NStateImp(compatm) used below + ! rather than NStateExp(n2), since the export state might only + ! contain control data and no grid information if if the target + ! component (n2) is not prognostic only receives control data back + + ! NOTE: this section must be done BEFORE the call to esmFldsExchange + ! Create field bundles for mediator ocean albedo computation + if ( is_local%wrap%med_coupling_active(compocn,compatm) .or. & is_local%wrap%med_coupling_active(compatm,compocn)) then - ! NOTE: the NStateImp(compocn) or NStateImp(compatm) used below - ! rather than NStateExp(n2), since the export state might only - ! contain control data and no grid information if if the target - ! component (n2) is not prognostic only receives control data back + if (.not. is_local%wrap%med_coupling_active(compatm,compocn)) then + is_local%wrap%med_coupling_active(compatm,compocn) = .true. + end if - ! NOTE: this section must be done BEFORE the call to esmFldsExchange ! Create field bundles for mediator ocean albedo computation - fieldCount = shr_nuopc_fldList_GetNumFlds(fldListMed_ocnalb) if (fieldCount > 0) then allocate(fldnames(fieldCount)) @@ -1670,15 +1552,28 @@ subroutine DataInitialize(gcomp, rc) call shr_nuopc_methods_FB_init(is_local%wrap%FBMed_ocnalb_a, flds_scalar_name, & STgeom=is_local%wrap%NStateImp(compatm), fieldnamelist=fldnames, name='FBMed_ocnalb_a', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) write(logunit,*) subname,' initializing FB FBMed_ocnalb_a' call shr_nuopc_methods_FB_init(is_local%wrap%FBMed_ocnalb_o, flds_scalar_name, & STgeom=is_local%wrap%NStateImp(compocn), fieldnamelist=fldnames, name='FBMed_ocnalb_o', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) write(logunit,*) subname,' initializing FB FBMed_ocnalb_o' deallocate(fldnames) + + ! The following assumes that the mediator atm/ocn flux calculation will be done on the ocean grid + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compatm,compocn), rc=rc)) then + call ESMF_LogWrite(trim(subname)//' creating field bundle FBImp(compatm,compocn)', ESMF_LOGMSG_INFO) + call shr_nuopc_methods_FB_init(is_local%wrap%FBImp(compatm,compocn), flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compocn), & + STflds=is_local%wrap%NStateImp(compatm), & + name='FBImp'//trim(compname(compatm))//'_'//trim(compname(compocn)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (mastertask) write(logunit,*) subname,' initializing FBs for '// & + trim(compname(compatm))//'_'//trim(compname(compocn)) end if ! Create field bundles for mediator ocean/atmosphere flux computation - fieldCount = shr_nuopc_fldList_GetNumFlds(fldListMed_aoflux) if (fieldCount > 0) then allocate(fldnames(fieldCount)) @@ -1688,10 +1583,12 @@ subroutine DataInitialize(gcomp, rc) call shr_nuopc_methods_FB_init(is_local%wrap%FBMed_aoflux_a, flds_scalar_name, & STgeom=is_local%wrap%NStateImp(compatm), fieldnamelist=fldnames, name='FBMed_aoflux_a', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) write(logunit,*) subname,' initializing FB FBMed_aoflux_a' call shr_nuopc_methods_FB_init(is_local%wrap%FBMed_aoflux_o, flds_scalar_name, & STgeom=is_local%wrap%NStateImp(compocn), fieldnamelist=fldnames, name='FBMed_aoflux_o', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) write(logunit,*) subname,' initializing FB FBMed_aoflux_o' deallocate(fldnames) end if end if @@ -1731,6 +1628,9 @@ subroutine DataInitialize(gcomp, rc) ! This is called every loop around DataInitialize !--------------------------------------- + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (shr_nuopc_methods_chkerr(rc,__LINE__,u_FILE_u)) return + do n1 = 1,ncomps LocalDone = .true. if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then @@ -1751,9 +1651,6 @@ subroutine DataInitialize(gcomp, rc) if (atCorrectTime) then if (fieldNameList(n) == flds_scalar_name) then - call med_infodata_CopyStateToInfodata(is_local%wrap%NStateImp(n1), med_infodata, & - trim(compname(n1))//'2cpli', is_local%wrap%vm, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//" MED - Initialize-Data-Dependency CSTI "//trim(compname(n1)), & ESMF_LOGMSG_INFO, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1765,9 +1662,11 @@ subroutine DataInitialize(gcomp, rc) deallocate(fieldNameList) if (LocalDone) then + ! This copies NStateImp(n1) TO FBImp(n1, n1) call shr_nuopc_methods_FB_copy(is_local%wrap%FBImp(n1,n1), is_local%wrap%NStateImp(n1), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//" MED - Initialize-Data-Dependency Copy Import "//trim(compname(n1)), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//" MED - Initialize-Data-Dependency Copy Import "//& + trim(compname(n1)), ESMF_LOGMSG_INFO, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return if (n1 == compocn) ocnDone = .true. if (n1 == compatm) atmDone = .true. @@ -1832,10 +1731,6 @@ subroutine DataInitialize(gcomp, rc) call med_phases_prep_atm(gcomp, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! copy the FBExp(compatm) to NstatExp(compatm) - call med_connectors_prep_med2atm(gcomp, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! change 'Updated' attribute to true for ALL exportState fields call ESMF_StateGet(is_local%wrap%NStateExp(compatm), itemCount=fieldCount, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1854,12 +1749,6 @@ subroutine DataInitialize(gcomp, rc) call ESMF_LogWrite("MED - Initialize-Data-Dependency Sending Data to ATM", ESMF_LOGMSG_INFO, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return endif - else - if (is_local%wrap%comp_present(compatm)) then - ! Copy the NstateImp(compatm) to FBImp(compatm) - call med_connectors_post_atm2med(gcomp, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if endif allDone = .true. @@ -1895,6 +1784,34 @@ subroutine DataInitialize(gcomp, rc) call ESMF_LogWrite("MED - Initialize-Data-Dependency allDone check Passed", ESMF_LOGMSG_INFO, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + !--------------------------------------- + ! Create component dimensions in mediator internal state + !--------------------------------------- + + write(logunit,*) + do n1 = 1,ncomps + if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then + call shr_nuopc_methods_State_GetScalar(scalar_value=real_nx, scalar_id=flds_scalar_index_nx, & + state=is_local%wrap%NstateImp(n1), flds_scalar_name=flds_scalar_name, & + flds_scalar_num=flds_scalar_num, rc=rc) + call shr_nuopc_methods_State_GetScalar(scalar_value=real_ny, scalar_id=flds_scalar_index_ny, & + state=is_local%wrap%NstateImp(n1), flds_scalar_name=flds_scalar_name, & + flds_scalar_num=flds_scalar_num, rc=rc) + is_local%wrap%nx(n1) = nint(real_nx) + is_local%wrap%ny(n1) = nint(real_ny) + write(msgString,'(2i8,2l4)') is_local%wrap%nx(n1), is_local%wrap%ny(n1) + if (mastertask) then + write(logunit,*) 'global nx,ny sizes for '//trim(compname(n1))//":"//trim(msgString) + end if + call ESMF_LogWrite(trim(subname)//":"//trim(compname(n1))//":"//trim(msgString), ESMF_LOGMSG_INFO) + end if + end do + write(logunit,*) + + !--------------------------------------- + ! Initialize mediator IO + !--------------------------------------- + call med_io_init() !--------------------------------------- @@ -1922,7 +1839,7 @@ subroutine DataInitialize(gcomp, rc) end if if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine DataInitialize @@ -1959,7 +1876,6 @@ subroutine SetRunClock(gcomp, rc) type(ESMF_ALARM) :: glc_avg_alarm logical :: glc_present character(len=16) :: glc_avg_period - integer :: dbrc integer :: first_time = .true. character(len=*),parameter :: subname='(module_MED:SetRunClock)' !----------------------------------------------------------- @@ -1967,7 +1883,7 @@ subroutine SetRunClock(gcomp, rc) rc = ESMF_SUCCESS if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif ! query the Mediator for clocks @@ -2085,7 +2001,7 @@ subroutine SetRunClock(gcomp, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) endif end subroutine SetRunClock diff --git a/src/drivers/nuopc/mediator/med_fraction_mod.F90 b/src/drivers/nuopc/mediator/med_fraction_mod.F90 index 1363f466da80..a7524da754cc 100644 --- a/src/drivers/nuopc/mediator/med_fraction_mod.F90 +++ b/src/drivers/nuopc/mediator/med_fraction_mod.F90 @@ -599,12 +599,15 @@ subroutine med_fraction_init(gcomp, rc) ! Diagnostic output !--------------------------------------- - do n = 1,ncomps - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBfrac(n), trim(subname) // trim(compname(n)), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif - enddo + if (dbug_flag > 1) then + do n = 1,ncomps + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBfrac(n), & + trim(subname) // trim(compname(n)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end do + end if if (dbug_flag > 20) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) @@ -633,6 +636,8 @@ subroutine med_fraction_set(gcomp, rc) use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFldPtr use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FieldRegrid use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_init + use shr_nuopc_scalars_mod , only : flds_scalar_name use perf_mod , only : t_startf, t_stopf ! input/output variables @@ -666,8 +671,15 @@ subroutine med_fraction_set(gcomp, rc) ! Update FBFrac(compice), FBFrac(compocn) and FBFrac(compatm) field bundles !--------------------------------------- - if (is_local%wrap%med_coupling_active(compice,compocn)) then + if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(compice,compocn,mapfcopy), rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compice,compocn))) then + call shr_nuopc_methods_FB_init(is_local%wrap%FBImp(compice,compocn), flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compocn), & + STflds=is_local%wrap%NStateImp(compice), & + name='FBImp'//trim(compname(compice))//'_'//trim(compname(compocn)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if call med_map_Fractions_init( gcomp, compice, compocn, & FBSrc=is_local%wrap%FBImp(compice,compice), & FBDst=is_local%wrap%FBImp(compice,compocn), & @@ -675,6 +687,13 @@ subroutine med_fraction_set(gcomp, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(compocn,compice,mapfcopy), rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compocn,compice))) then + call shr_nuopc_methods_FB_init(is_local%wrap%FBImp(compocn,compice), flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compice), & + STflds=is_local%wrap%NStateImp(compocn), & + name='FBImp'//trim(compname(compocn))//'_'//trim(compname(compice)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if call med_map_Fractions_init( gcomp, compocn, compice, & FBSrc=is_local%wrap%FBImp(compocn,compocn), & FBDst=is_local%wrap%FBImp(compocn,compice), & @@ -718,19 +737,15 @@ subroutine med_fraction_set(gcomp, rc) ! The following is just a redistribution from FBFrac(compice) - ! Map 'ifrac' from FBfrac(compice) to FBfrac(compocn) if (is_local%wrap%comp_present(compocn)) then - if (is_local%wrap%med_coupling_active(compice,compocn)) then - call shr_nuopc_methods_FB_FieldRegrid(& - is_local%wrap%FBfrac(compice), 'ifrac', & - is_local%wrap%FBfrac(compocn), 'ifrac', & - is_local%wrap%RH(compice,compocn,mapfcopy), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end if + ! Map 'ifrac' from FBfrac(compice) to FBfrac(compocn) + call shr_nuopc_methods_FB_FieldRegrid(& + is_local%wrap%FBfrac(compice), 'ifrac', & + is_local%wrap%FBfrac(compocn), 'ifrac', & + is_local%wrap%RH(compice,compocn,mapfcopy), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! Map 'ofrac' from FBfrac(compice) to FBfrac(comp) - if (is_local%wrap%med_coupling_active(compice,compocn)) then + ! Map 'ofrac' from FBfrac(compice) to FBfrac(compocn) call shr_nuopc_methods_FB_FieldRegrid(& is_local%wrap%FBfrac(compice), 'ofrac', & is_local%wrap%FBfrac(compocn), 'ofrac', & @@ -822,12 +837,15 @@ subroutine med_fraction_set(gcomp, rc) ! Diagnostic output !--------------------------------------- - do n = 1,ncomps - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBfrac(n), trim(subname) // trim(compname(n))//' frac', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif - enddo + if (dbug_flag > 1) then + do n = 1,ncomps + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBfrac(n), & + trim(subname) // trim(compname(n))//' frac', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + enddo + end if if (dbug_flag > 20) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) diff --git a/src/drivers/nuopc/mediator/med_internalstate_mod.F90 b/src/drivers/nuopc/mediator/med_internalstate_mod.F90 index 5ad35244786b..fa565718cf06 100644 --- a/src/drivers/nuopc/mediator/med_internalstate_mod.F90 +++ b/src/drivers/nuopc/mediator/med_internalstate_mod.F90 @@ -50,6 +50,12 @@ module med_internalstate_mod ! FBImp(n,k) is the FBImp(n,n) interpolated to grid k ! RH(n,k,m) is a RH from grid n to grid k, map type m + ! Mediator vm + type(ESMF_VM) :: vm + + ! Global nx,ny dimensions of input arrays (needed for mediator history output) + integer :: nx(ncomps), ny(ncomps) + ! Present/Active logical flags logical :: comp_present(ncomps) ! comp present flag logical :: med_coupling_active(ncomps,ncomps) ! computes the active coupling @@ -82,11 +88,6 @@ module med_internalstate_mod type(ESMF_FieldBundle) :: FBImpAccum(ncomps,ncomps) ! Accumulator for various components import integer :: FBImpAccumCnt(ncomps) ! Accumulator counter for each FBImpAccum - ! Connectors - integer :: conn_prep_cnt(ncomps) ! Connector prep count - integer :: conn_post_cnt(ncomps) ! Connector post count - type(ESMF_VM) :: vm - end type InternalStateStruct type, public :: InternalState diff --git a/src/drivers/nuopc/mediator/med_io_mod.F90 b/src/drivers/nuopc/mediator/med_io_mod.F90 index 9c8028831325..f5ba2091ff05 100644 --- a/src/drivers/nuopc/mediator/med_io_mod.F90 +++ b/src/drivers/nuopc/mediator/med_io_mod.F90 @@ -2,10 +2,11 @@ module med_io_mod ! !DESCRIPTION: Writes attribute vectors to netcdf ! !USES: - use ESMF, only : ESMF_VM - use med_constants_mod , only : CL - use pio, only : file_desc_t, iosystem_desc_t - use shr_nuopc_utils_mod, only : shr_nuopc_utils_ChkErr + use ESMF , only : ESMF_VM + use med_constants_mod , only : CL + use pio , only : file_desc_t, iosystem_desc_t + use shr_nuopc_utils_mod , only : shr_nuopc_utils_ChkErr + implicit none private @@ -20,6 +21,9 @@ module med_io_mod public med_io_write public med_io_init + ! private member functions + private :: med_io_file_exists + ! public data members: interface med_io_read module procedure med_io_read_FB @@ -40,22 +44,21 @@ module med_io_mod end interface med_io_write !------------------------------------------------------------------------------- - ! Local data + ! module data !------------------------------------------------------------------------------- - character(*),parameter :: prefix = "med_io_" - character(*),parameter :: modName = "(med_io_mod) " - character(*),parameter :: version = "cmeps0" - - integer , parameter :: file_desc_t_cnt = 20 ! Note - this is hard-wired for now - character(*),parameter :: u_file_u = & - __FILE__ - + character(*),parameter :: prefix = "med_io_" + character(*),parameter :: modName = "(med_io_mod) " + character(*),parameter :: version = "cmeps0" + integer , parameter :: file_desc_t_cnt = 20 ! Note - this is hard-wired for now + integer , parameter :: number_strlen = 2 character(CL) :: wfilename = '' type(file_desc_t) :: io_file(0:file_desc_t_cnt) integer :: pio_iotype integer :: pio_ioformat type(iosystem_desc_t), pointer :: io_subsystem + character(*),parameter :: u_file_u = & + __FILE__ !================================================================================= contains @@ -69,13 +72,15 @@ logical function med_io_file_exists(vm, iam, filename) use ESMF, only : ESMF_VMBroadCast + ! input/output variables type(ESMF_VM) :: vm integer, intent(in) :: iam character(len=*), intent(in) :: filename - logical :: exists + ! local variables integer :: tmp(1) integer :: rc + !------------------------------------------------------------------------------- med_io_file_exists = .false. if (iam==0) inquire(file=trim(filename),exist=med_io_file_exists) @@ -127,7 +132,6 @@ subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) character(CL), optional, intent(in) :: model_doi_url ! local variables - logical :: exists logical :: lclobber integer :: tmp(1) integer :: rcode @@ -207,12 +211,14 @@ end subroutine med_io_wopen !=============================================================================== subroutine med_io_close(filename, iam, file_ind) + !--------------- + ! close netcdf file + !--------------- + use pio, only: pio_file_is_open, pio_closefile use med_internalstate_mod, only : logunit use shr_sys_mod, only : shr_sys_abort - ! !DESCRIPTION: close netcdf file - ! input/output variables character(*), intent(in) :: filename integer, intent(in) :: iam @@ -242,26 +248,38 @@ end subroutine med_io_close !=============================================================================== subroutine med_io_redef(filename,file_ind) + use pio, only : pio_redef + + ! input/output variables character(len=*), intent(in) :: filename integer,optional,intent(in):: file_ind + ! local variables integer :: lfile_ind integer :: rcode + !------------------------------------------------------------------------------- lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind rcode = pio_redef(io_file(lfile_ind)) + end subroutine med_io_redef !=============================================================================== subroutine med_io_enddef(filename,file_ind) - use med_internalstate_mod, only : logunit - use pio, only : pio_enddef - character(len=*), intent(in) :: filename - integer,optional,intent(in):: file_ind + + use med_internalstate_mod , only : logunit + use pio , only : pio_enddef + + ! input/output variables + character(len=*) , intent(in) :: filename + integer,optional , intent(in) :: file_ind + + ! local variables integer :: lfile_ind integer :: rcode + !------------------------------------------------------------------------------- lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind @@ -271,22 +289,24 @@ end subroutine med_io_enddef !=============================================================================== character(len=24) function med_io_date2yyyymmdd (date) + use shr_cal_mod, only : shr_cal_datetod2string - ! input arguments + integer, intent(in) :: date ! date expressed as an integer: yyyymmdd - !---------------------------------------------------------------------- call shr_cal_datetod2string(date_str = med_io_date2yyyymmdd, ymd = date) end function med_io_date2yyyymmdd !=============================================================================== character(len=8) function med_io_sec2hms (seconds) - use shr_sys_mod, only : shr_sys_abort + + use shr_sys_mod , only : shr_sys_abort use med_internalstate_mod , only : logunit - ! Input arguments + + ! input arguments integer, intent(in) :: seconds - ! Local workspace + ! local variables integer :: hours ! hours of hh:mm:ss integer :: minutes ! minutes of hh:mm:ss integer :: secs ! seconds of hh:mm:ss @@ -320,22 +340,25 @@ end function med_io_sec2hms subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & fillval, pre, tavg, use_float, file_ind, rc) - ! !DESCRIPTION: Write FB to netcdf file - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundle, ESMF_Field, ESMF_Mesh, ESMF_DistGrid + !--------------- + ! Write FB to netcdf file + !--------------- + + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundle, ESMF_Mesh, ESMF_DistGrid use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_MeshGet, ESMF_DistGridGet -! use ESMF , only : ESMF_VMGetCurrent, ESMF_VMGet - use med_constants_mod , only : R4, R8 + use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_AttributeGet + use med_constants_mod , only : R4, R8, dbug_flag=>med_constants_dbug_flag use shr_const_mod , only : fillvalue=>SHR_CONST_SPVAL - use pio , only : var_desc_t, io_desc_t, pio_offset_kind - use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFieldN use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFldPtr use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getNameN use esmFlds , only : shr_nuopc_fldList_GetMetadata + use pio , only : var_desc_t, io_desc_t, pio_offset_kind use pio , only : pio_def_dim, pio_inq_dimid, pio_real, pio_def_var, pio_put_att, pio_double use pio , only : pio_inq_varid, pio_setframe, pio_write_darray, pio_initdecomp, pio_freedecomp use pio , only : pio_syncfile + ! input/output variables character(len=*), intent(in) :: filename ! file integer, intent(in) :: iam ! local pet @@ -360,7 +383,7 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & integer :: mpicom integer :: rcode integer :: nf,ns,ng - integer :: k + integer :: k,n integer ,target :: dimid2(2) integer ,target :: dimid3(3) integer ,pointer :: dimid(:) @@ -382,20 +405,23 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & integer :: dimCount, tileCount integer, pointer :: Dof(:) integer :: lfile_ind - real(r8), pointer :: fldptr1(:), tmpfldptr(:) + real(r8), pointer :: fldptr1(:) + real(r8), pointer :: fldptr2(:,:) + character(len=number_strlen) :: cnumber character(CL) :: tmpstr - integer :: dbrc + type(ESMF_Field) :: lfield + integer :: rank + integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields + integer :: gridToFieldMap(1) ! currently the size must equal 1 for rank 2 fields + logical :: isPresent character(*),parameter :: subName = '(med_io_write_FB) ' !------------------------------------------------------------------------------- if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_Success -! call ESMF_VMGetCurrent(vm, rc=rc) -! call ESMF_VMGet(vm, mpiCommunicator=mpicom, rc=rc) - lfillvalue = fillvalue if (present(fillval)) then lfillvalue = fillval @@ -406,10 +432,10 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & lpre = trim(pre) endif - if (.not. ESMF_FieldBundleIsCreated(FB,rc=rc)) then - call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" not created", ESMF_LOGMSG_INFO, rc=rc) + if (.not. ESMF_FieldBundleIsCreated(FB, rc=rc)) then + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" not created", ESMF_LOGMSG_INFO) if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif rc = ESMF_Success return @@ -423,7 +449,7 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & if (.not.lwhead .and. .not.lwdata) then ! should we write a warning? if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif return endif @@ -436,11 +462,11 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & call ESMF_FieldBundleGet(FB, fieldCount=nf, rc=rc) write(tmpstr,*) subname//' field count = '//trim(lpre),nf - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) if (nf < 1) then - call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" empty", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" empty", ESMF_LOGMSG_INFO) if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif rc = ESMF_Success return @@ -462,8 +488,8 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, maxIndexPTile=maxIndexPTile, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - ! write(tmpstr,*) subname,' counts = ',dimcount,tilecount,minindexptile,maxindexptile - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + ! write(tmpstr,*) subname,' counts = ',dimcount,tilecount,minindexptile,maxindexptile + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) ! TODO: this is not getting the global size correct for a FB coming in that does not have ! all the global grid values in the distgrid - e.g. CTSM @@ -485,7 +511,7 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & endif if (lnx*lny /= ng) then write(tmpstr,*) subname,' ERROR: grid2d size not consistent ',ng,lnx,lny - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) !TODO: this should not be an error for say CTSM which does not send a global grid !rc = ESMF_FAILURE @@ -504,74 +530,144 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & dimid => dimid2 endif - write(tmpstr,*) subname,' tcx dimid = ',dimid - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + write(tmpstr,*) subname,' dimid = ',dimid + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) do k = 1,nf call shr_nuopc_methods_FB_getNameN(FB, k, itemc, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - !-------tcraig, this is a temporary mod to NOT write hgt + ! Determine rank of field with name itemc + call ESMF_FieldBundleGet(FB, itemc, field=lfield, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, rank=rank, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + ! TODO (mvertens, 2019-03-13): this is a temporary mod to NOT write hgt if (trim(itemc) /= "hgt") then - name1 = trim(lpre)//'_'//trim(itemc) - call shr_nuopc_fldList_GetMetadata(itemc,longname=lname,stdname=sname,units=cunit) - call ESMF_LogWrite(trim(subname)//':'//trim(itemc)//':'//trim(name1),ESMF_LOGMSG_INFO, rc=rc) - if (luse_float) then - rcode = pio_def_var(io_file(lfile_ind),trim(name1),PIO_REAL,dimid,varid) - rcode = pio_put_att(io_file(lfile_ind),varid,"_FillValue",real(lfillvalue,r4)) + if (rank == 2) then + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + write(cnumber,'(i0)') ungriddedUbound(1) + call ESMF_LogWrite(trim(subname)//':'//'field '//trim(itemc)// & + ' has an griddedUBound of '//trim(cnumber), ESMF_LOGMSG_INFO) + + ! Create a new output variable for each element of the undistributed dimension + do n = 1,ungriddedUBound(1) + if (trim(itemc) /= "hgt") then + write(cnumber,'(i0)') n + name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) + call shr_nuopc_fldList_GetMetadata(itemc, longname=lname, stdname=sname, units=cunit) + call ESMF_LogWrite(trim(subname)//': defining '//trim(name1), ESMF_LOGMSG_INFO) + + if (luse_float) then + rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid) + rcode = pio_put_att(io_file(lfile_ind), varid,"_FillValue",real(lfillvalue,r4)) + else + rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(io_file(lfile_ind),varid,"_FillValue",lfillvalue) + end if + rcode = pio_put_att(io_file(lfile_ind), varid, "units" , trim(cunit)) + rcode = pio_put_att(io_file(lfile_ind), varid, "long_name" , trim(lname)) + rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(sname)) + if (present(tavg)) then + if (tavg) then + rcode = pio_put_att(io_file(lfile_ind), varid, "cell_methods", "time: mean") + endif + endif + end if + end do else - rcode = pio_def_var(io_file(lfile_ind),trim(name1),PIO_DOUBLE,dimid,varid) - rcode = pio_put_att(io_file(lfile_ind),varid,"_FillValue",lfillvalue) + name1 = trim(lpre)//'_'//trim(itemc) + call shr_nuopc_fldList_GetMetadata(itemc,longname=lname,stdname=sname,units=cunit) + call ESMF_LogWrite(trim(subname)//':'//trim(itemc)//':'//trim(name1),ESMF_LOGMSG_INFO) + if (luse_float) then + rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid) + rcode = pio_put_att(io_file(lfile_ind), varid, "_FillValue", real(lfillvalue, r4)) + else + rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(io_file(lfile_ind), varid, "_FillValue", lfillvalue) + end if + rcode = pio_put_att(io_file(lfile_ind), varid, "units" , trim(cunit)) + rcode = pio_put_att(io_file(lfile_ind), varid, "long_name" , trim(lname)) + rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name" , trim(sname)) + if (present(tavg)) then + if (tavg) then + rcode = pio_put_att(io_file(lfile_ind), varid, "cell_methods", "time: mean") + endif + end if end if - rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) - rcode = pio_put_att(io_file(lfile_ind),varid,"long_name",trim(lname)) - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(sname)) - if (present(tavg)) then - if (tavg) then - rcode = pio_put_att(io_file(lfile_ind),varid,"cell_methods","time: mean") - endif - endif - endif - !-------tcraig - enddo + end if + end do + + ! Finish define mode if (lwdata) call med_io_enddef(filename, file_ind=lfile_ind) + end if if (lwdata) then + ! use distgrid extracted from field 1 above call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return allocate(dof(ns)) call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) write(tmpstr,*) subname,' dof = ',ns,size(dof),dof(1),dof(ns) !,minval(dof),maxval(dof) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) -! call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom) + ! call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom) deallocate(dof) do k = 1,nf call shr_nuopc_methods_FB_getNameN(FB, k, itemc, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_getFldPtr(FB, itemc, fldptr1=fldptr1, rc=rc) + + call shr_nuopc_methods_FB_getFldPtr(FB, itemc, & + fldptr1=fldptr1, fldptr2=fldptr2, rank=rank, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - !-------tcraig, this is a temporary mod to NOT write hgt + + ! TODO (mvertens, 2019-03-13): this is a temporary mod to NOT write hgt if (trim(itemc) /= "hgt") then - name1 = trim(lpre)//'_'//trim(itemc) - rcode = pio_inq_varid(io_file(lfile_ind),trim(name1),varid) - call pio_setframe(io_file(lfile_ind),varid,frame) - call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr1, rcode, fillval=lfillvalue) - !-------tcraig - endif - enddo - call pio_syncfile(io_file(lfile_ind)) + if (rank == 2) then + + ! Determine the size of the ungridded dimension and the index where the undistributed dimension is located + call ESMF_FieldBundleGet(FB, itemc, field=lfield, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, gridToFieldMap=gridToFieldMap, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + ! Output for each ungriddedUbound index + do n = 1,ungriddedUBound(1) + write(cnumber,'(i0)') n + name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) + rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) + call pio_setframe(io_file(lfile_ind),varid,frame) + + if (gridToFieldMap(1) == 1) then + call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr2(:,n), rcode, fillval=lfillvalue) + else if (gridToFieldMap(1) == 2) then + call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr2(n,:), rcode, fillval=lfillvalue) + end if + end do + else if (rank == 1) then + name1 = trim(lpre)//'_'//trim(itemc) + rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) + call pio_setframe(io_file(lfile_ind),varid,frame) + call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr1, rcode, fillval=lfillvalue) + end if ! end if rank is 2 or 1 + + end if ! end if not "hgt" + end do ! end loop over fields in FB + call pio_syncfile(io_file(lfile_ind)) call pio_freedecomp(io_file(lfile_ind), iodesc) endif if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine med_io_write_FB @@ -582,7 +678,9 @@ subroutine med_io_write_int(filename, iam, idata, dname, whead, wdata, file_ind) use pio , only : var_desc_t, pio_def_var, pio_put_att, pio_int, pio_inq_varid, pio_put_var use esmFlds, only : shr_nuopc_fldList_GetMetadata - ! !DESCRIPTION: Write scalar integer to netcdf file + !--------------- + ! Write scalar integer to netcdf file + !--------------- ! intput/output variables character(len=*),intent(in) :: filename ! file @@ -639,13 +737,15 @@ end subroutine med_io_write_int !=============================================================================== subroutine med_io_write_int1d(filename, iam, idata, dname, whead, wdata, file_ind) + !--------------- + ! Write 1d integer array to netcdf file + !--------------- + use pio , only : var_desc_t, pio_def_dim, pio_def_var use pio , only : pio_put_att, pio_inq_varid, pio_put_var use pio , only : pio_int, pio_def_var use esmFlds , only : shr_nuopc_fldList_GetMetadata - ! !DESCRIPTION: Write 1d integer array to netcdf file - ! input/output arguments character(len=*),intent(in) :: filename ! file integer ,intent(in) :: iam ! local pet @@ -704,13 +804,15 @@ end subroutine med_io_write_int1d !=============================================================================== subroutine med_io_write_r8(filename, iam, rdata, dname, whead, wdata, file_ind) + !--------------- + ! Write scalar double to netcdf file + !--------------- + use med_constants_mod , only : R8 use pio , only : var_desc_t, pio_def_var, pio_put_att use pio , only : pio_double, pio_noerr, pio_inq_varid, pio_put_var use esmFlds , only : shr_nuopc_fldList_GetMetadata - ! !DESCRIPTION: Write scalar double to netcdf file - ! input/output arguments character(len=*),intent(in) :: filename ! file integer ,intent(in) :: iam ! local pet @@ -766,7 +868,9 @@ end subroutine med_io_write_r8 !=============================================================================== subroutine med_io_write_r81d(filename, iam, rdata, dname, whead, wdata, file_ind) - ! !DESCRIPTION: Write 1d double array to netcdf file + !--------------- + ! Write 1d double array to netcdf file + !--------------- use med_constants_mod , only : R8 use pio , only : var_desc_t, pio_def_dim, pio_def_var @@ -828,7 +932,9 @@ end subroutine med_io_write_r81d !=============================================================================== subroutine med_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind) - ! !DESCRIPTION: Write char string to netcdf file + !--------------- + ! Write char string to netcdf file + !--------------- use pio , only : var_desc_t, pio_def_dim, pio_put_att, pio_def_var, pio_inq_varid use pio , only : pio_char, pio_put_var @@ -891,6 +997,10 @@ end subroutine med_io_write_char subroutine med_io_write_time(filename, iam, time_units, time_cal, time_val, nt,& whead, wdata, tbnds, file_ind) + !--------------- + ! Write time variable to netcdf file + !--------------- + use med_constants_mod , only : R8 use shr_cal_mod , only : shr_cal_calMaxLen use shr_cal_mod , only : shr_cal_noleap @@ -900,8 +1010,6 @@ subroutine med_io_write_time(filename, iam, time_units, time_cal, time_val, nt,& use pio , only : pio_double, pio_def_dim, pio_def_var, pio_put_att use pio , only : pio_inq_varid, pio_put_var - ! !DESCRIPTION: Write time variable to netcdf file - ! input/output variables character(len=*), intent(in) :: filename ! file integer, intent(in) :: iam ! local pet @@ -988,6 +1096,10 @@ end subroutine med_io_write_time !=============================================================================== subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) + !--------------- + ! Read FB from netcdf file + !--------------- + use med_constants_mod , only : R8, CL use shr_const_mod , only : fillvalue=>SHR_CONST_SPVAL use ESMF , only : ESMF_FieldBundle, ESMF_Field, ESMF_Mesh, ESMF_DistGrid @@ -996,57 +1108,49 @@ subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet use ESMF , only : ESMF_FieldGet, ESMF_MeshGet, ESMF_DistGridGet use pio , only : file_desc_T, var_desc_t, io_desc_t, pio_nowrite, pio_openfile - use pio , only : pio_noerr, pio_inq_varndims, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR - use pio , only : pio_inq_dimid, pio_inq_dimlen, pio_inq_varid, pio_inq_vardimid + use pio , only : pio_noerr, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR + use pio , only : pio_inq_varid use pio , only : pio_double, pio_get_att, pio_seterrorhandling, pio_freedecomp, pio_closefile - use pio , only : pio_read_darray, pio_initdecomp, pio_offset_kind - use pio , only : pio_setframe + use pio , only : pio_read_darray, pio_offset_kind, pio_setframe use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getNameN use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFldPtr use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFieldN - ! !DESCRIPTION: Read FB to netcdf file - - ! !input/output arguments - character(len=*) ,intent(in) :: filename ! file - type(ESMF_VM) :: vm - integer ,intent(in) :: iam - type(ESMF_FieldBundle) ,intent(in) :: FB ! data to be read - character(len=*),optional ,intent(in) :: pre ! prefix to variable name - integer(kind=PIO_OFFSET_KIND),optional ,intent(in) :: frame - integer ,intent(out) :: rc + ! input/output arguments + character(len=*) ,intent(in) :: filename ! file + type(ESMF_VM) ,intent(in) :: vm + integer ,intent(in) :: iam + type(ESMF_FieldBundle) ,intent(in) :: FB ! data to be read + character(len=*) ,optional ,intent(in) :: pre ! prefix to variable name + integer(kind=PIO_OFFSET_KIND) ,optional ,intent(in) :: frame + integer ,intent(out) :: rc ! local variables - - type(ESMF_Field) :: field - type(ESMF_Mesh) :: mesh - type(ESMF_Distgrid) :: distgrid - integer :: rcode - integer :: nf,ns,ng - integer :: k,n,ndims - integer, pointer :: dimid(:) - type(file_desc_t) :: pioid - type(var_desc_t) :: varid - type(io_desc_t) :: iodesc - character(CL) :: itemc ! string converted to char - character(CL) :: name1 ! var name - character(CL) :: lpre ! local prefix - integer :: lnx,lny - real(r8) :: lfillvalue - logical :: exists - integer :: tmp(1) - integer, pointer :: minIndexPTile(:,:) - integer, pointer :: maxIndexPTile(:,:) - integer :: dimCount, tileCount - integer, pointer :: Dof(:) - real(r8), pointer :: fldptr1(:) - character(CL) :: tmpstr + type(ESMF_Field) :: lfield + integer :: rcode + integer :: nf,ns,ng + integer :: k,n,l + type(file_desc_t) :: pioid + type(var_desc_t) :: varid + type(io_desc_t) :: iodesc + character(CL) :: itemc ! string converted to char + character(CL) :: name1 ! var name + character(CL) :: lpre ! local prefix + real(r8) :: lfillvalue + integer :: tmp(1) + integer :: rank, lsize + real(r8), pointer :: fldptr1(:), fldptr1_tmp(:) + real(r8), pointer :: fldptr2(:,:) + character(CL) :: tmpstr + character(len=16) :: cnumber integer(kind=Pio_Offset_Kind) :: lframe + integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fieldds + integer :: gridToFieldMap(1) ! currently the size must equal 1 for rank 2 fieldds character(*),parameter :: subName = '(med_io_read_FB) ' !------------------------------------------------------------------------------- rc = ESMF_Success - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return lpre = ' ' @@ -1059,10 +1163,10 @@ subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) lframe = 1 endif if (.not. ESMF_FieldBundleIsCreated(FB,rc=rc)) then - call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" not created", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" not created", ESMF_LOGMSG_INFO) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return endif return @@ -1071,13 +1175,13 @@ subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) call ESMF_FieldBundleGet(FB, fieldCount=nf, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write(tmpstr,*) subname//' field count = '//trim(lpre),nf - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (nf < 1) then - call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" empty", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" empty", ESMF_LOGMSG_INFO) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return endif return @@ -1085,110 +1189,242 @@ subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) if (med_io_file_exists(vm, iam, trim(filename))) then rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) - call ESMF_LogWrite(trim(subname)//' open file '//trim(filename), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//' open file '//trim(filename), ESMF_LOGMSG_INFO) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return else call ESMF_LogWrite(trim(subname)//' ERROR: file invalid '//trim(filename), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=rc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif + call pio_seterrorhandling(pioid, PIO_BCAST_ERROR) + do k = 1,nf + ! Get name of field call shr_nuopc_methods_FB_getNameN(FB, k, itemc, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_getFldPtr(FB, itemc, fldptr1=fldptr1, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - name1 = trim(lpre)//'_'//trim(itemc) - call ESMF_LogWrite(trim(subname)//' read field '//trim(name1), ESMF_LOGMSG_INFO, rc=rc) + ! Get iodesc for all fields based on iodesc of first field (assumes that all fields have + ! the same iodesc) + if (k == 1) then + call ESMF_FieldBundleGet(FB, itemc, field=lfield, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, rank=rank, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (rank == 2) then + name1 = trim(lpre)//'_'//trim(itemc)//'1' + else if (rank == 1) then + name1 = trim(lpre)//'_'//trim(itemc) + end if + call med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + end if + + call ESMF_LogWrite(trim(subname)//' reading field '//trim(itemc), ESMF_LOGMSG_INFO) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call pio_seterrorhandling(pioid, PIO_BCAST_ERROR) - rcode = pio_inq_varid(pioid,trim(name1),varid) - if (rcode == pio_noerr) then - - if (k == 1) then - rcode = pio_inq_varndims(pioid, varid, ndims) - write(tmpstr,*) trim(subname),' ndims = ',ndims,k - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - allocate(dimid(ndims)) - rcode = pio_inq_vardimid(pioid, varid, dimid(1:ndims)) - rcode = pio_inq_dimlen(pioid, dimid(1), lnx) - write(tmpstr,*) trim(subname),' lnx = ',lnx - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - if (ndims>=2) then - rcode = pio_inq_dimlen(pioid, dimid(2), lny) + + ! Get pointer to field bundle field + ! Field bundle might be 2d or 1d - but field on mediator history or restart file will always be 1d + call shr_nuopc_methods_FB_getFldPtr(FB, itemc, & + fldptr1=fldptr1, fldptr2=fldptr2, rank=rank, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + if (rank == 2) then + + ! Determine the size of the ungridded dimension and the + ! index where the undistributed dimension is located + call ESMF_FieldBundleGet(FB, itemc, field=lfield, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, gridToFieldMap=gridToFieldMap, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + if (gridToFieldMap(1) == 1) then + lsize = size(fldptr2, dim=1) + else if (gridToFieldMap(1) == 2) then + lsize = size(fldptr2, dim=2) + end if + allocate(fldptr1_tmp(lsize)) + + do n = 1,ungriddedUBound(1) + ! Creat a name for the 1d field on the mediator history or restart file based on the + ! ungridded dimension index of the field bundle 2d fiedl + write(cnumber,'(i0)') n + name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) + + rcode = pio_inq_varid(pioid, trim(name1), varid) + if (rcode == pio_noerr) then + call ESMF_LogWrite(trim(subname)//' read field '//trim(name1), ESMF_LOGMSG_INFO) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call pio_setframe(pioid, varid, lframe) + call pio_read_darray(pioid, varid, iodesc, fldptr1_tmp, rcode) + rcode = pio_get_att(pioid, varid, "_FillValue", lfillvalue) + if (rcode /= pio_noerr) then + lfillvalue = fillvalue + endif + do l = 1,size(fldptr1_tmp) + if (fldptr1_tmp(l) == lfillvalue) fldptr1_tmp(l) = 0.0_r8 + enddo else - lny = 1 + fldptr1_tmp = 0.0_r8 + endif + if (gridToFieldMap(1) == 1) then + fldptr2(:,n) = fldptr1_tmp(:) + else if (gridToFieldMap(1) == 2) then + fldptr2(n,:) = fldptr1_tmp(:) end if - deallocate(dimid) - write(tmpstr,*) trim(subname),' lny = ',lny - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - ng = lnx * lny - - call shr_nuopc_methods_FB_getFieldN(FB, k, field, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, mesh=mesh, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - allocate(minIndexPTile(dimCount, tileCount), & - maxIndexPTile(dimCount, tileCount)) - call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & - maxIndexPTile=maxIndexPTile, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - !write(tmpstr,*) subname,' counts = ',dimcount,tilecount,minindexptile,maxindexptile - !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - - if (ng > maxval(maxIndexPTile)) then - write(tmpstr,*) subname,' ERROR: dimensions do not match', lnx, lny, maxval(maxIndexPTile) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=rc) - - !TODO: this should not be an error for say CTSM which does not send a global grid - !rc = ESMF_Failure - !return + end do + + deallocate(fldptr1_tmp) + + else if (rank == 1) then + name1 = trim(lpre)//'_'//trim(itemc) + + rcode = pio_inq_varid(pioid, trim(name1), varid) + if (rcode == pio_noerr) then + call ESMF_LogWrite(trim(subname)//' read field '//trim(name1), ESMF_LOGMSG_INFO) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call pio_setframe(pioid,varid,lframe) + call pio_read_darray(pioid, varid, iodesc, fldptr1, rcode) + rcode = pio_get_att(pioid,varid,"_FillValue",lfillvalue) + if (rcode /= pio_noerr) then + lfillvalue = fillvalue endif - - call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - allocate(dof(ns)) - call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) - write(tmpstr,*) subname,' dof = ',ns,size(dof),dof(1),dof(ns) !,minval(dof),maxval(dof) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) - deallocate(dof) - endif - call pio_setframe(pioid,varid,lframe) - call pio_read_darray(pioid, varid, iodesc, fldptr1, rcode) - rcode = pio_get_att(pioid,varid,"_FillValue",lfillvalue) - if (rcode /= pio_noerr) then - lfillvalue = fillvalue + do n = 1,size(fldptr1) + if (fldptr1(n) == lfillvalue) fldptr1(n) = 0.0_r8 + enddo + else + fldptr1 = 0.0_r8 endif - do n = 1,size(fldptr1) - if (fldptr1(n) == lfillvalue) fldptr1(n) = 0.0_r8 - enddo - else - fldptr1 = 0.0_r8 - endif - call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) - enddo + end if + + enddo ! end of loop over fields + call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) - deallocate(minIndexPTile, maxIndexPTile) call pio_freedecomp(pioid, iodesc) call pio_closefile(pioid) if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine med_io_read_FB + !=============================================================================== + subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) + + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundle, ESMF_Mesh, ESMF_DistGrid + use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_MeshGet, ESMF_DistGridGet + use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_AttributeGet + use pio , only : file_desc_T, var_desc_t, io_desc_t, pio_nowrite, pio_openfile + use pio , only : pio_noerr, pio_inq_varndims + use pio , only : pio_inq_dimid, pio_inq_dimlen, pio_inq_varid, pio_inq_vardimid + use pio , only : pio_double, pio_seterrorhandling, pio_initdecomp + use shr_nuopc_methods_mod, only : shr_nuopc_methods_FB_getFieldN + + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: name1 + type(file_desc_t) , intent(in) :: pioid + type(io_desc_t) , intent(inout) :: iodesc + integer , intent(out) :: rc + + ! local variables + type(ESMF_Field) :: field + type(ESMF_Mesh) :: mesh + type(ESMF_Distgrid) :: distgrid + integer :: rcode + integer :: ns,ng + integer :: n,ndims + integer, pointer :: dimid(:) + type(var_desc_t) :: varid + integer :: lnx,lny + integer :: tmp(1) + integer, pointer :: minIndexPTile(:,:) + integer, pointer :: maxIndexPTile(:,:) + integer :: dimCount, tileCount + integer, pointer :: Dof(:) + character(CL) :: tmpstr + integer :: rank + character(*),parameter :: subName = '(med_io_read_init_iodesc) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + rcode = pio_inq_varid(pioid, trim(name1), varid) + if (rcode == pio_noerr) then + + rcode = pio_inq_varndims(pioid, varid, ndims) + write(tmpstr,*) trim(subname),' ndims = ',ndims + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + + allocate(dimid(ndims)) + rcode = pio_inq_vardimid(pioid, varid, dimid(1:ndims)) + rcode = pio_inq_dimlen(pioid, dimid(1), lnx) + write(tmpstr,*) trim(subname),' lnx = ',lnx + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + if (ndims>=2) then + rcode = pio_inq_dimlen(pioid, dimid(2), lny) + else + lny = 1 + end if + deallocate(dimid) + + write(tmpstr,*) trim(subname),' lny = ',lny + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + ng = lnx * lny + + call shr_nuopc_methods_FB_getFieldN(FB, 1, field, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(field, mesh=mesh, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + allocate(minIndexPTile(dimCount, tileCount), maxIndexPTile(dimCount, tileCount)) + call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & + maxIndexPTile=maxIndexPTile, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + !write(tmpstr,*) subname,' counts = ',dimcount,tilecount,minindexptile,maxindexptile + !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + + if (ng > maxval(maxIndexPTile)) then + write(tmpstr,*) subname,' WARNING: dimensions do not match', lnx, lny, maxval(maxIndexPTile) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + !TODO: this should not be an error for say CTSM which does not send a global grid + !rc = ESMF_Failure + !return + endif + + call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + allocate(dof(ns)) + call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) + write(tmpstr,*) subname,' dof = ',ns,size(dof),dof(1),dof(ns) !,minval(dof),maxval(dof) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + + call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) + deallocate(dof) + + deallocate(minIndexPTile, maxIndexPTile) + + end if ! end if rcode check + + end subroutine med_io_read_init_iodesc + !=============================================================================== subroutine med_io_read_int(filename, vm, iam, idata, dname) - ! !DESCRIPTION: Read scalar integer from netcdf file + !--------------- + ! Read scalar integer from netcdf file + !--------------- ! input/output arguments character(len=*) , intent(in) :: filename ! file @@ -1210,7 +1446,9 @@ end subroutine med_io_read_int !=============================================================================== subroutine med_io_read_int1d(filename, vm, iam, idata, dname) - ! !DESCRIPTION: Read 1d integer array from netcdf file + !--------------- + ! Read 1d integer array from netcdf file + !--------------- use shr_sys_mod , only : shr_sys_abort use med_constants_mod , only : R8 @@ -1231,7 +1469,6 @@ subroutine med_io_read_int1d(filename, vm, iam, idata, dname) integer :: rcode type(file_desc_t) :: pioid type(var_desc_t) :: varid - logical :: exists character(CL) :: lversion character(CL) :: name1 integer :: rc @@ -1265,7 +1502,9 @@ end subroutine med_io_read_int1d subroutine med_io_read_r8(filename, vm, iam, rdata, dname) use med_constants_mod, only : R8 - ! !DESCRIPTION: Read scalar double from netcdf file + !--------------- + ! Read scalar double from netcdf file + !--------------- ! input/output arguments character(len=*) , intent(in) :: filename ! file @@ -1285,13 +1524,17 @@ end subroutine med_io_read_r8 !=============================================================================== subroutine med_io_read_r81d(filename, vm, iam, rdata, dname) + + !--------------- + ! Read 1d double array from netcdf file + !--------------- + use med_constants_mod, only : R8 use pio, only : file_desc_t, var_desc_t, pio_openfile, pio_closefile, pio_seterrorhandling use pio, only : PIO_BCAST_ERROR, PIO_INTERNAL_ERROR, pio_inq_varid, pio_get_var use pio, only : pio_nowrite, pio_openfile, pio_global, pio_get_att use med_internalstate_mod, only : logunit use shr_sys_mod, only : shr_sys_abort - ! !DESCRIPTION: Read 1d double array from netcdf file ! input/output arguments character(len=*), intent(in) :: filename ! file @@ -1304,8 +1547,6 @@ subroutine med_io_read_r81d(filename, vm, iam, rdata, dname) integer :: rcode type(file_desc_T) :: pioid type(var_desc_t) :: varid - logical :: exists - integer :: rc character(CL) :: lversion character(CL) :: name1 @@ -1337,12 +1578,16 @@ end subroutine med_io_read_r81d !=============================================================================== subroutine med_io_read_char(filename, vm, iam, rdata, dname) - use pio, only : file_desc_t, var_desc_t, pio_seterrorhandling, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR - use pio, only : pio_closefile, pio_inq_varid, pio_get_var - use pio, only : pio_openfile, pio_global, pio_get_att, pio_nowrite - use med_internalstate_mod, only : logunit - use shr_sys_mod, only : shr_sys_abort - ! !DESCRIPTION: Read char string from netcdf file + + !--------------- + ! Read char string from netcdf file + !--------------- + + use pio , only : file_desc_t, var_desc_t, pio_seterrorhandling, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR + use pio , only : pio_closefile, pio_inq_varid, pio_get_var + use pio , only : pio_openfile, pio_global, pio_get_att, pio_nowrite + use med_internalstate_mod , only : logunit + use shr_sys_mod , only : shr_sys_abort ! input/output arguments character(len=*), intent(in) :: filename ! file @@ -1355,11 +1600,10 @@ subroutine med_io_read_char(filename, vm, iam, rdata, dname) integer :: rcode type(file_desc_T) :: pioid type(var_desc_t) :: varid - logical :: exists integer :: rc character(CL) :: lversion character(CL) :: name1 - character(CL) :: charvar ! buffer for string read/write + character(CL) :: charvar ! buffer for string read/write character(*),parameter :: subName = '(med_io_read_char) ' !------------------------------------------------------------------------------- diff --git a/src/drivers/nuopc/mediator/med_map_mod.F90 b/src/drivers/nuopc/mediator/med_map_mod.F90 index 454e1e0d0592..b71758f7aa06 100644 --- a/src/drivers/nuopc/mediator/med_map_mod.F90 +++ b/src/drivers/nuopc/mediator/med_map_mod.F90 @@ -4,6 +4,9 @@ module med_map_mod use med_constants_mod , only : ispval_mask => med_constants_ispval_mask use med_constants_mod , only : czero => med_constants_czero use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use esmFlds , only : mapbilnr, mapconsf, mapconsd, mappatch, mapfcopy + use esmFlds , only : mapunset, mapnames + use esmFlds , only : mapnstod, mapnstod_consd, mapnstod_consf implicit none private @@ -21,10 +24,10 @@ module med_map_mod ! private module variables - character(*) , parameter :: u_FILE_u = __FILE__ - ! should this be a module variable? - integer :: srcTermProcessing_Value = 0 - logical :: mastertask + integer :: srcTermProcessing_Value = 0 ! should this be a module variable? + logical :: mastertask + character(*), parameter :: u_FILE_u = & + __FILE__ !================================================================================ contains @@ -70,9 +73,6 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) use NUOPC , only : NUOPC_Write use esmFlds , only : ncomps, compice, compocn, compname use esmFlds , only : fldListFr, fldListTo - use esmFlds , only : mapnames - use esmFlds , only : mapbilnr, mapconsf, mapconsd, mappatch, mapfcopy - use esmFlds , only : mapunset, mapfiler, mapnstod, mapnstod_consd, mapnstod_consf use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFieldN use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use med_internalstate_mod , only : InternalState @@ -105,7 +105,6 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) character(CL) , pointer :: fldnames(:) !integer(ESMF_KIND_I4), pointer :: unmappedDstList(:) character(len=128) :: logMsg - integer :: dbrc type(ESMF_PoleMethod_Flag), parameter :: polemethod=ESMF_POLEMETHOD_ALLAVG character(len=*), parameter :: subname=' (module_med_map: RouteHandles_init) ' !----------------------------------------------------------- @@ -187,45 +186,35 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) mapfile = trim(fldListFr(n1)%flds(nf)%mapfile(n2)) string = trim(rhname)//'_weights' - if (mapindex == mapfiler .and. mapfile /= 'unset') then - ! TODO: actually error out if mapfile is unset in this case - if (mastertask) then - write(llogunit,'(4A)') subname,trim(string),' RH '//trim(mapname)//' via input file ',& - trim(mapfile) - end if - call ESMF_LogWrite(subname // trim(string) //& - ' RH '//trim(mapname)//' via input file '//trim(mapfile), ESMF_LOGMSG_INFO, rc=dbrc) - call ESMF_FieldSMMStore(fldsrc, flddst, mapfile, & - routehandle=is_local%wrap%RH(n1,n2,mapindex), & - ignoreUnmatchedIndices=.true., & - srcTermProcessing=srcTermProcessing_Value, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - else if (mapindex == mapfcopy) then + if (mapindex == mapfcopy) then + ! Create redist route handle if (mastertask) then write(llogunit,'(3A)') subname,trim(string),' RH redist ' end if - call ESMF_LogWrite(trim(subname) // trim(string) // ' RH redist ', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname) // trim(string) // ' RH redist ', ESMF_LOGMSG_INFO) call ESMF_FieldRedistStore(fldsrc, flddst, & routehandle=is_local%wrap%RH(n1,n2,mapindex), & ignoreUnmatchedIndices = .true., rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return else if (mapfile /= 'unset') then + ! Get route handle from mapping file if (mastertask) then write(llogunit,'(4A)') subname,trim(string),' RH '//trim(mapname)//' via input file ',& trim(mapfile) end if call ESMF_LogWrite(subname // trim(string) //& - ' RH '//trim(mapname)//' via input file '//trim(mapfile), ESMF_LOGMSG_INFO, rc=dbrc) + ' RH '//trim(mapname)//' via input file '//trim(mapfile), ESMF_LOGMSG_INFO) call ESMF_FieldSMMStore(fldsrc, flddst, mapfile, & routehandle=is_local%wrap%RH(n1,n2,mapindex), & ignoreUnmatchedIndices=.true., & srcTermProcessing=srcTermProcessing_Value, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return else + ! Create route handle on the fly if (mastertask) write(llogunit,'(3A)') subname,trim(string),& ' RH regrid for '//trim(mapname)//' computed on the fly' call ESMF_LogWrite(subname // trim(string) //& - ' RH regrid for '//trim(mapname)//' computed on the fly', ESMF_LOGMSG_INFO, rc=dbrc) + ' RH regrid for '//trim(mapname)//' computed on the fly', ESMF_LOGMSG_INFO) if (mapindex == mapbilnr) then srcTermProcessing_Value = 0 call ESMF_FieldRegridStore(fldsrc, flddst, & @@ -299,12 +288,12 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) end if !if (associated(unmappedDstList)) then ! write(logMsg,*) trim(subname),trim(string),' number of unmapped dest points = ', size(unmappedDstList) - ! call ESMF_LogWrite(trim(logMsg), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite(trim(logMsg), ESMF_LOGMSG_INFO) !end if end if if (rhprint_flag .and. mapindex /= mapnstod_consd .and. mapindex /= mapnstod_consf) then call ESMF_LogWrite(trim(subname)//trim(string)//": printing RH for "//trim(mapname), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) call ESMF_RouteHandlePrint(is_local%wrap%RH(n1,n2,mapindex), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -313,7 +302,7 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) if ( mapindex /= mapnstod_consd .and. mapindex /= mapnstod_consf .and. & .not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(n1,n2,mapindex), rc=rc)) then call ESMF_LogWrite(trim(subname)//trim(string)//": failed RH "//trim(mapname), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) endif end if end do ! loop over fields @@ -323,7 +312,7 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) end do ! loop over n1 if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif call t_stopf('MED:'//subname) @@ -366,7 +355,6 @@ subroutine med_map_Fractions_init(gcomp, n1, n2, FBSrc, FBDst, RouteHandle, rc) integer :: SrcMaskValue integer :: DstMaskValue real(R8), pointer :: factorList(:) - integer :: dbrc character(len=*), parameter :: subname=' (med_map_fractions_init: ) ' !--------------------------------------------- call t_startf('MED:'//subname) @@ -402,14 +390,14 @@ subroutine med_map_Fractions_init(gcomp, n1, n2, FBSrc, FBDst, RouteHandle, rc) if (mapfile == 'idmap') then call ESMF_LogWrite(trim(subname) // trim(string) //& - ' RH '//trim(mapname)// ' is redist', ESMF_LOGMSG_INFO, rc=dbrc) + ' RH '//trim(mapname)// ' is redist', ESMF_LOGMSG_INFO) call ESMF_FieldRedistStore(fldsrc, flddst, & routehandle=RouteHandle, & ignoreUnmatchedIndices = .true., rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return else if (mapfile /= 'unset') then call ESMF_LogWrite(subname // trim(string) //& - ' RH '//trim(mapname)//' via input file '//trim(mapfile), ESMF_LOGMSG_INFO, rc=dbrc) + ' RH '//trim(mapname)//' via input file '//trim(mapfile), ESMF_LOGMSG_INFO) call ESMF_FieldSMMStore(fldsrc, flddst, mapfile, & routehandle=RouteHandle, & ignoreUnmatchedIndices=.true., & @@ -417,7 +405,7 @@ subroutine med_map_Fractions_init(gcomp, n1, n2, FBSrc, FBDst, RouteHandle, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return else call ESMF_LogWrite(subname // trim(string) //& - ' RH '//trim(mapname)//' computed on the fly '//trim(mapfile), ESMF_LOGMSG_INFO, rc=dbrc) + ' RH '//trim(mapname)//' computed on the fly '//trim(mapfile), ESMF_LOGMSG_INFO) call ESMF_FieldRegridStore(fldsrc, flddst, & routehandle=RouteHandle, & srcMaskValues=(/srcMaskValue/), & @@ -431,7 +419,7 @@ subroutine med_map_Fractions_init(gcomp, n1, n2, FBSrc, FBDst, RouteHandle, rc) end if if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif call t_stopf('MED:'//subname) @@ -459,6 +447,7 @@ subroutine med_map_MapNorm_init(gcomp, llogunit, rc) use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_FieldRegrid use shr_nuopc_methods_mod , only: shr_nuopc_methods_ChkErr use perf_mod , only: t_startf, t_stopf + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(in) :: llogunit @@ -471,7 +460,6 @@ subroutine med_map_MapNorm_init(gcomp, llogunit, rc) character(len=CS) :: normname character(len=1) :: cn1,cn2,cm real(R8), pointer :: dataptr(:) - integer :: dbrc character(len=*),parameter :: subname='(module_MED_MAP:MapNorm_init)' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -500,7 +488,7 @@ subroutine med_map_MapNorm_init(gcomp, llogunit, rc) write(cn1,'(i1)') n1; write(cn2,'(i1)') n2; write(cm ,'(i1)') m call ESMF_LogWrite(trim(subname)//":"//'creating FBMapNormOne for '& //compname(n1)//'->'//compname(n2)//'with mapping '//mapnames(m), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) endif call shr_nuopc_methods_FB_init(FBout=is_local%wrap%FBNormOne(n1,n2,m), & flds_scalar_name=flds_scalar_name, & @@ -537,7 +525,7 @@ subroutine med_map_MapNorm_init(gcomp, llogunit, rc) end do if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif call t_stopf('MED:'//subname) @@ -546,7 +534,7 @@ end subroutine med_map_MapNorm_init !================================================================================ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & - FBSrc, FBDst, FBFrac, FBNormOne, RouteHandles, string, rc) + FBSrc, FBDst, FBFracSrc, FBFracDst, FBNormOne, RouteHandles, string, rc) ! ---------------------------------------------- ! Map field bundles with appropriate fraction weighting @@ -554,10 +542,11 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & use NUOPC , only: NUOPC_IsConnected use ESMF , only: ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only: ESMF_LOGMSG_ERROR, ESMF_FAILURE + use ESMF , only: ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_MAXSTR use ESMF , only: ESMF_FieldBundle, ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet - use ESMF , only: ESMF_RouteHandle, ESMF_RouteHandleIsCreated, ESMF_Field + use ESMF , only: ESMF_RouteHandle, ESMF_RouteHandleIsCreated use ESMF , only: ESMF_REGION_SELECT, ESMF_REGION_TOTAL + use ESMF , only: ESMF_Field, ESMF_FieldGet use esmFlds , only: compname use esmFlds , only: mapnames, mapfcopy, mapconsd, mapconsf, mapnstod use esmFlds , only: mapnstod_consd, mapnstod_consf @@ -580,32 +569,32 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & integer , intent(in) :: destcomp type(ESMF_FieldBundle) , intent(inout) :: FBSrc type(ESMF_FieldBundle) , intent(inout) :: FBDst - type(ESMF_FieldBundle) , intent(in) :: FBFrac + type(ESMF_FieldBundle) , intent(in) :: FBFracSrc + type(ESMF_FieldBundle) , intent(in) :: FBFracDst type(ESMF_FieldBundle) , intent(in) :: FBNormOne(:) type(ESMF_RouteHandle) , intent(inout) :: RouteHandles(:) character(len=*), optional , intent(in) :: string integer , intent(out) :: rc ! local variables - integer :: i, n - type(ESMF_Field) :: srcField - type(ESMF_Field) :: tmpfield - integer :: mapindex - character(len=CS) :: lstring - character(len=CS) :: mapnorm - character(len=CS) :: fldname - real(R8), allocatable :: data_srctmp(:) ! temporary - real(R8), allocatable :: data_dsttmp(:) ! temporary - real(R8), pointer :: data_src(:) - real(R8), pointer :: data_dst(:) - real(R8), pointer :: data_frac(:) - real(R8), pointer :: data_norm(:) - integer :: dbrc + integer :: i, n, k + character(len=CS) :: lstring + integer :: mapindex + character(len=CS) :: mapnorm + character(len=CS) :: fldname + type(ESMF_Field) :: srcField + type(ESMF_Field) :: dstField + type(ESMF_Field) :: lfield + real(R8), allocatable :: data_srctmp(:) + real(R8), pointer :: data_src(:) + real(R8), pointer :: data_dst(:) + real(R8), pointer :: data_frac(:) + real(R8), pointer :: data_norm(:) character(len=*), parameter :: subname='(module_MED_Map:med_map_Regrid_Norm)' !------------------------------------------------------------------------------- call t_startf('MED:'//subname) - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) call shr_nuopc_memcheck(subname, 1, mastertask) !--------------------------------------- @@ -631,9 +620,10 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & !--------------------------------------- call ESMF_LogWrite(trim(subname)//" *** mapping from "//trim(compname(srccomp))//" to "//& - trim(compname(destcomp))//" ***", ESMF_LOGMSG_INFO, rc=dbrc) + trim(compname(destcomp))//" ***", ESMF_LOGMSG_INFO) do n = 1,size(fldsSrc) + ! Determine if field is a scalar - and if so go to next iternation fldname = fldsSrc(n)%shortname if (fldname == flds_scalar_name) CYCLE @@ -643,17 +633,33 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & if (mapindex == 0) CYCLE mapnorm = fldsSrc(n)%mapnorm(destcomp) + ! Determine if field is FBSrc or FBDst or connected - and if not go to next iteration + if (.not. shr_nuopc_methods_FB_FldChk(FBSrc, trim(fldname), rc=rc)) then + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//" field not found in FBSrc: "//trim(fldname), ESMF_LOGMSG_INFO) + end if + CYCLE + else if (.not. shr_nuopc_methods_FB_FldChk(FBDst, trim(fldname), rc=rc)) then + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//" field not found in FBDst: "//trim(fldname), ESMF_LOGMSG_INFO) + end if + CYCLE + end if + + ! ------------------- ! Error checks + ! ------------------- + if (.not. shr_nuopc_methods_FB_FldChk(FBSrc, fldname, rc=rc)) then - call ESMF_LogWrite(trim(subname)//" field not found in FBSrc: "//trim(fldname), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//" field not found in FBSrc: "//trim(fldname), ESMF_LOGMSG_INFO) else if (.not. shr_nuopc_methods_FB_FldChk(FBDst, fldname, rc=rc)) then - call ESMF_LogWrite(trim(subname)//" field not found in FBDst: "//trim(fldname), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//" field not found in FBDst: "//trim(fldname), ESMF_LOGMSG_INFO) else if (mapindex == mapnstod_consd) then if (.not. ESMF_RouteHandleIsCreated(RouteHandles(mapconsd), rc=rc) .or. & .not. ESMF_RouteHandleIsCreated(RouteHandles(mapnstod), rc=rc)) then call ESMF_LogWrite(trim(subname)//trim(lstring)//& ": ERROR RH not available for "//mapnames(mapindex)//": fld="//trim(fldname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return end if @@ -662,35 +668,34 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & .not. ESMF_RouteHandleIsCreated(RouteHandles(mapnstod), rc=rc)) then call ESMF_LogWrite(trim(subname)//trim(lstring)//& ": ERROR RH not available for "//mapnames(mapindex)//": fld="//trim(fldname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return end if else if (.not. ESMF_RouteHandleIsCreated(RouteHandles(mapindex), rc=rc)) then call ESMF_LogWrite(trim(subname)//trim(lstring)//& ": ERROR RH not available for "//mapnames(mapindex)//": fld="//trim(fldname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return end if - ! Determine if field is FBSrc or FBDst or connected - and if not go to next iteration - if (.not. shr_nuopc_methods_FB_FldChk(FBSrc, trim(fldname), rc=rc)) then - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//" field not found in FBSrc: "//trim(fldname), ESMF_LOGMSG_INFO, rc=dbrc) - end if - CYCLE - else if (.not. shr_nuopc_methods_FB_FldChk(FBDst, trim(fldname), rc=rc)) then - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//" field not found in FBDst: "//trim(fldname), ESMF_LOGMSG_INFO, rc=dbrc) - end if - CYCLE - end if + ! ------------------- + ! Get the source and destination fields + ! ------------------- call ESMF_LogWrite(trim(subname)//" --> remapping "//trim(fldname)//" with "//trim(mapnames(mapindex)), & ESMF_LOGMSG_INFO) + call ESMF_FieldBundleGet(FBSrc, fieldName=trim(fldname), field=srcfield, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(FBDst, fieldName=trim(fldname), field=dstfield, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! ------------------- ! Do the mapping + ! ------------------- + if (mapindex == mapfcopy) then call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapindex), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -701,10 +706,16 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & if ( trim(mapnorm) /= 'unset' .and. trim(mapnorm) /= 'one' .and. trim(mapnorm) /= 'none') then - ! Get field and pointer to source field data in FBSrc - call shr_nuopc_methods_FB_GetFldPtr(FBSrc, fldname, data_src, field=srcfield, rc=rc) + !------------------------------------------------- + ! fractional normalization (1) + ! multiple source field by fraction and map product + !------------------------------------------------- + + ! get a pointer to source field data in FBSrc + call shr_nuopc_methods_FB_GetFldPtr(FBSrc, fldname, data_src, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! allocate memory for a save array if not already allocated if (.not. allocated(data_srctmp) .or. size(data_srctmp) /= size(data_src)) then if (allocated(data_srctmp)) then deallocate(data_srctmp) @@ -712,192 +723,213 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & allocate(data_srctmp(size(data_src))) endif - !------------------------------------------------- - ! fractional normalization - !------------------------------------------------- - ! get a pointer to the array of the normalization on the source grid - this must ! be the same size is as fraction on the source grid - call shr_nuopc_methods_FB_GetFldPtr(FBFrac, trim(mapnorm), data_frac, rc=rc) + call shr_nuopc_methods_FB_GetFldPtr(FBFracSrc, trim(mapnorm), data_frac, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! regrid FBSrc to FBDst - ! Copy data_src to data_srctmp and multiply by fraction, regrid this then replace with original data_src + ! - copy data_src to data_srctmp + ! - multiply by fraction, regrid this then replace with original data_src + ! - regrid field with name fldname from FBsrc to FBDst + ! - restore original value data_srctmp = data_src data_src = data_src * data_frac + call map_field_src2dst (fldname, srcfield, dstfield, RouteHandles, mapindex, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + data_src = data_srctmp - if (mapindex == mapnstod_consd) then - call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapnstod), rc, & - zeroregion=ESMF_REGION_TOTAL) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - ! temp diagnostics - call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after nstod: ", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapconsd), rc, & - zeroregion=ESMF_REGION_SELECT) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! get the field from FBFrac that has the target normalization fraction + call shr_nuopc_methods_FB_GetFldPtr(FBFracDst, mapnorm, data_norm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! temp diagnostics - call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after consd: ", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! normalize destination mapped values by the reciprocal of the mapped fraction + call norm_field_dest(trim(fldname), dstfield, data_norm, rc) - else if (mapindex == mapnstod_consf) then - call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapnstod), rc, & - zeroregion=ESMF_REGION_TOTAL) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else if (trim(mapnorm) == 'one' .or. trim(mapnorm) == 'none') then - ! temp diagnostics - call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after nstod: ", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + !------------------------------------------------- + ! unity or no normalization + !------------------------------------------------- - call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapconsf), rc, & - zeroregion=ESMF_REGION_SELECT) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! map src field to destination grid + call map_field_src2dst (trim(fldname), srcfield, dstfield, RouteHandles, mapindex, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! temp diagnostics - call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after consf: ", rc=rc) + ! obtain unity normalization factor and multiply interpolated field by reciprocal of normalization factor + if (trim(mapnorm) == 'one') then + call ESMF_FieldBundleGet(FBNormOne(mapindex), fieldName='one', field=lfield, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - else - - call shr_nuopc_methods_FB_FieldRegrid( FBSrc, trim(fldname), FBDst, fldname, RouteHandles(mapindex), rc) + call ESMF_FieldGet(lfield, farrayPtr=data_norm, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - ! Restore original value - data_src = data_srctmp - - call shr_nuopc_methods_FB_GetFldPtr(FBDst, trim(fldname), data_dst, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - if (.not. allocated(data_dsttmp) .or. size(data_dsttmp) /= size(data_dst)) then - if(allocated(data_dsttmp)) then - deallocate(data_dsttmp) - endif - allocate(data_dsttmp(size(data_dst))) - endif - - ! Copy data_dst to tmp location, regrid fraction from source - data_dsttmp = data_dst - data_dst = czero + call norm_field_dest(trim(fldname), dstfield, data_norm, rc) + end if ! mapnorm is 'one' - if (mapindex == mapnstod_consd) then - call shr_nuopc_methods_FB_FieldRegrid(FBFrac, mapnorm, FBDst, trim(fldname), RouteHandles(mapnstod), rc, & - zeroregion=ESMF_REGION_TOTAL) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_FieldRegrid(FBFrac, mapnorm, FBDst, trim(fldname), RouteHandles(mapconsd), rc, & - zeroregion=ESMF_REGION_SELECT) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - else if (mapindex == mapnstod_consf) then - call shr_nuopc_methods_FB_FieldRegrid(FBFrac, mapnorm, FBDst, trim(fldname), RouteHandles(mapnstod), rc, & - zeroregion=ESMF_REGION_TOTAL) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_FieldRegrid(FBFrac, mapnorm, FBDst, trim(fldname), RouteHandles(mapconsf), rc, & - zeroregion=ESMF_REGION_SELECT) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - else - call shr_nuopc_methods_FB_FieldRegrid(FBFrac, mapnorm, FBDst, trim(fldname), RouteHandles(mapindex), rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if + end if ! mapnorm is 'one' or 'nne' + end if ! mapindex is not mapfcopy and field exists - do i= 1,size(data_dst) - if (data_dst(i) /= 0.0_R8) then - data_dst(i) = data_dsttmp(i)/data_dst(i) - endif - end do + !if (dbug_flag > 1) then + call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, & + string=trim(subname) //' FBImp('//trim(compname(srccomp))//','//trim(compname(destcomp))//') ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + !end if - ! temp diagnostics - call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after frac: ", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end do ! loop over fields + if (allocated(data_srctmp)) deallocate(data_srctmp) - else if (trim(mapnorm) == 'one' .or. trim(mapnorm) == 'none') then + call t_stopf('MED:'//subname) - !------------------------------------------------- - ! unity or no normalization - !------------------------------------------------- + end subroutine med_map_FB_Regrid_Norm_All - ! map source field to destination grid - mapindex = fldsSrc(n)%mapindex(destcomp) + !================================================================================ - if (mapindex == mapnstod_consd) then + subroutine map_field_src2dst (fldname, srcfield, dstfield, RouteHandles, mapindex, rc) - call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapnstod), rc, & - zeroregion=ESMF_REGION_TOTAL) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + !--------------------------------------------------- + ! map the source field to the destination field + !--------------------------------------------------- - ! temp diagnostics - call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after nstod: ", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_MAXSTR + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet + use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldRegrid + use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_Region_Flag, ESMF_REGION_TOTAL + use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandleIsCreated + use shr_nuopc_methods_mod , only : shr_nuopc_methods_Field_diagnose + use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_chkerr - call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapconsd), rc, & - zeroregion=ESMF_REGION_SELECT) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! input/output variables + character(len=*) , intent(in) :: fldname + type(ESMF_Field) , intent(in) :: srcfield + type(ESMF_Field) , intent(inout) :: dstfield + type(ESMF_RouteHandle) , intent(inout) :: RouteHandles(:) + integer , intent(in) :: mapindex + integer , intent(out) :: rc - ! temp diagnostics - call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after consd: ", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! local variables + logical :: checkflag = .false. + !--------------------------------------------------- - else if (mapindex == mapnstod_consf) then - call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapnstod), rc, & - zeroregion=ESMF_REGION_TOTAL) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + rc = ESMF_SUCCESS - ! temp diagnostics - call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after nstod: ", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return +#ifdef DEBUG + checkflag = .true. +#endif - call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapconsf), rc, & - zeroregion=ESMF_REGION_SELECT) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (mapindex == mapnstod_consd) then + call ESMF_FieldRegrid(srcfield, dstfield, routehandle=RouteHandles(mapnstod), & + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_Field_diagnose(dstfield, fldname, " --> after nstod: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + call ESMF_FieldRegrid(srcfield, dstfield, routehandle=RouteHandles(mapconsd), & + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_Field_diagnose(dstfield, fldname, " --> after consd: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + else if (mapindex == mapnstod_consf) then + call ESMF_FieldRegrid(srcfield, dstfield, routehandle=RouteHandles(mapnstod), & + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_Field_diagnose(dstfield, fldname, " --> after nstod: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + call ESMF_FieldRegrid(srcfield, dstfield, routehandle=RouteHandles(mapconsf), & + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_Field_diagnose(dstfield, fldname, " --> after consf: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + else + call ESMF_FieldRegrid(srcfield, dstfield, routehandle=RouteHandles(mapindex), & + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if - ! temp diagnostics - call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after consf: ", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine map_field_src2dst - else + !================================================================================ - call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapindex), rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - end if + subroutine norm_field_dest (fldname, dstfield, frac, rc) - ! obtain unity normalization factor and multiply interpolated field by reciprocal of normalization factor - if (trim(mapnorm) == 'one') then - call shr_nuopc_methods_FB_GetFldPtr(FBNormOne(mapindex), 'one', data_norm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + !------------------------------------------------ + ! normalize destination mapped values by the reciprocal of the + ! mapped fraction or 'one' + ! ------------------------------------------------ - call shr_nuopc_methods_FB_GetFldPtr(FBDst, trim(fldname), data_dst, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + use ESMF , only : ESMF_Field, ESMF_FieldGet + use ESMF , only : ESMF_SUCCESS + use shr_nuopc_methods_mod , only : shr_nuopc_methods_Field_Diagnose + use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_chkerr - do i= 1,size(data_dst) - if (data_norm(i) == 0.0_R8) then - data_dst(i) = 0.0_R8 - else - data_dst(i) = data_dst(i)/data_norm(i) - endif - enddo - end if ! mapnorm is 'one' + ! input/output variables + character(len=*) , intent(in) :: fldname + type(ESMF_Field) , intent(inout) :: dstfield + real(r8) , intent(in) :: frac(:) + integer , intent(out) :: rc - end if ! mapnorm is 'one' or 'nne' - end if ! mapindex is not mapfcopy and field exists + ! local variables + integer :: i,n + integer :: lrank + real(R8), pointer :: data1d(:) + real(R8), pointer :: data2d(:,:) + integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields + integer :: gridToFieldMap(1) ! currently the size must equal 1 for rank 2 fields + ! ------------------------------------------------ - !if (dbug_flag > 1) then - call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, & - string=trim(subname) //' FBImp('//trim(compname(srccomp))//','//trim(compname(destcomp))//') ', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - !end if + rc = ESMF_SUCCESS - end do ! loop over fields + call ESMF_FieldGet(dstfield, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - if (allocated(data_srctmp)) deallocate(data_srctmp) - if (allocated(data_dsttmp)) deallocate(data_dsttmp) + if (lrank == 1) then + call ESMF_FieldGet(dstfield, farrayPtr=data1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do i= 1,size(data1d) + if (frac(i) == 0.0_R8) then + data1d(i) = 0.0_R8 + else + data1d(i) = data1d(i)/frac(i) + endif + enddo + else if (lrank == 2) then + call ESMF_FieldGet(dstfield, ungriddedUBound=ungriddedUBound, gridToFieldMap=gridToFieldMap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(dstfield, farrayPtr=data2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,ungriddedUbound(1) + if (gridToFieldMap(1) == 1) then + do i = 1,size(data2d,dim=1) + if (frac(i) == 0.0_r8) then + data2d(i,n) = 0.0_r8 + else + data2d(i,n) = data2d(i,n)/frac(i) + end if + end do + else if (gridToFieldMap(1) == 2) then + do i = 1,size(data2d,dim=2) + if (frac(i) == 0.0_r8) then + data2d(n,i) = 0.0_r8 + else + data2d(n,i) = data2d(n,i)/frac(i) + end if + end do + end if + end do + end if - call t_stopf('MED:'//subname) + call shr_nuopc_methods_Field_diagnose(dstfield, fldname, " --> after frac: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - end subroutine med_map_FB_Regrid_Norm_All + end subroutine norm_field_dest !================================================================================ @@ -948,14 +980,13 @@ subroutine med_map_FB_Regrid_Norm_Frac(fldnames, FBSrc, FBDst, & real(R8), pointer :: data_dstnorm(:) ! temporary real(R8), pointer :: data_frac(:) ! temporary real(R8), pointer :: data_norm(:) ! temporary - integer :: dbrc character(len=*), parameter :: subname='(module_MED_Map:med_map_Regrid_Norm)' !------------------------------------------------------------------------------- call t_startf('MED:'//subname) rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) call shr_nuopc_memcheck(subname, 1, mastertask) @@ -1018,12 +1049,12 @@ subroutine med_map_FB_Regrid_Norm_Frac(fldnames, FBSrc, FBDst, & ! error checks if (size(data_srcnorm) /= size(data_frac)) then call ESMF_LogWrite(trim(subname)//" fldname= "//trim(fldnames(n))//" mapnorm= "//trim(mapnorm), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) write(csize1,'(i8)') size(data_srcnorm) write(csize2,'(i8)') size(data_frac) call ESMF_LogWrite(trim(subname)//": ERROR data_normsrc size "//trim(csize1)//& " and data_frac size "//trim(csize2)//" are inconsistent", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return else if (size(data_srcnorm) /= size(data_srctmp)) then @@ -1031,7 +1062,7 @@ subroutine med_map_FB_Regrid_Norm_Frac(fldnames, FBSrc, FBDst, & write(csize2,'(i8)') size(data_srctmp) call ESMF_LogWrite(trim(subname)//": ERROR data_srcnorm size "//trim(csize1)//& " and data_srctmp size "//trim(csize2)//" are inconsistent", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return end if @@ -1046,7 +1077,7 @@ subroutine med_map_FB_Regrid_Norm_Frac(fldnames, FBSrc, FBDst, & ! regrid FBSrcTmp to FBDst if (trim(fldnames(n)) == trim(flds_scalar_name)) then call ESMF_LogWrite(trim(subname)//trim(lstring)//": skip : fld="//trim(fldnames(n)), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) else call shr_nuopc_methods_FB_FieldRegrid( FBSrcTmp, 'data_srctmp', FBDst, fldnames(n), RouteHandle, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/drivers/nuopc/mediator/med_merge_mod.F90 b/src/drivers/nuopc/mediator/med_merge_mod.F90 index b52cfd96eb17..7343fd957b5a 100644 --- a/src/drivers/nuopc/mediator/med_merge_mod.F90 +++ b/src/drivers/nuopc/mediator/med_merge_mod.F90 @@ -31,8 +31,7 @@ module med_merge_mod contains !----------------------------------------------------------------------------- - subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, FBMed2, & - document, string, mastertask, rc) + subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, FBMed2, rc) use ESMF , only : ESMF_FieldBundle use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet @@ -63,9 +62,6 @@ subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, type(shr_nuopc_fldList_type) , intent(in) :: fldListTo ! Information for merging type(ESMF_FieldBundle) , intent(in) , optional :: FBMed1 ! mediator field bundle type(ESMF_FieldBundle) , intent(in) , optional :: FBMed2 ! mediator field bundle - logical , intent(in) :: document - character(len=*) , intent(in) :: string - logical , intent(in) :: mastertask integer , intent(out) :: rc ! local variables @@ -207,25 +203,33 @@ end subroutine med_merge_auto subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fldw, rc) use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LogMsg_Error - use ESMF , only : ESMF_FieldBundle, ESMF_LogWrite, ESMF_LogMsg_Info + use ESMF , only : ESMF_LogWrite, ESMF_LogMsg_Info + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet + use ESMF , only : ESMF_FieldGet, ESMF_Field use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FldChk - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_GetFldPtr + use shr_sys_mod , only : shr_sys_abort + ! input/output variables character(len=*) ,intent(in) :: merge_type type(ESMF_FieldBundle),intent(inout) :: FBout character(len=*) ,intent(in) :: FBoutfld type(ESMF_FieldBundle),intent(in) :: FB character(len=*) ,intent(in) :: FBfld - type(ESMF_FieldBundle),intent(inout) :: FBw - character(len=*) ,intent(in) :: fldw + type(ESMF_FieldBundle),intent(inout) :: FBw ! field bundle with weights + character(len=*) ,intent(in) :: fldw ! name of weight field to use in FBw integer ,intent(out) :: rc ! local variables - real(R8), pointer :: dp1 (:), dp2(:,:) - real(R8), pointer :: dpf1(:), dpf2(:,:) - real(R8), pointer :: dpw1(:), dpw2(:,:) - integer :: lrank - integer :: dbrc + integer :: n + type(ESMF_Field) :: lfield + real(R8), pointer :: dp1 (:), dp2(:,:) ! output pointers to 1d and 2d fields + real(R8), pointer :: dpf1(:), dpf2(:,:) ! intput pointers to 1d and 2d fields + real(R8), pointer :: dpw1(:) ! weight pointer + integer :: lrank ! rank of array + integer :: ungriddedUBound_output(1) ! currently the size must equal 1 for rank 2 fieldds + integer :: ungriddedUBound_input(1) ! currently the size must equal 1 for rank 2 fieldds + integer :: gridToFieldMap_output(1) ! currently the size must equal 1 for rank 2 fieldds + integer :: gridToFieldMap_input(1) ! currently the size must equal 1 for rank 2 fieldds character(len=*),parameter :: subname=' (med_merge_mod: med_merge)' !--------------------------------------- @@ -238,13 +242,13 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld if (merge_type == 'copy_with_weights' .or. merge_type == 'merge') then if (trim(fldw) == 'unset') then call ESMF_LogWrite(trim(subname)//": error required merge_fracname is not set", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return end if if (.not. shr_nuopc_methods_FB_FldChk(FBw, trim(fldw), rc=rc)) then call ESMF_LogWrite(trim(subname)//": error "//trim(fldw)//"is not in FBw", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return end if @@ -254,33 +258,54 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld ! Get appropriate field pointers !------------------------- - call shr_nuopc_methods_FB_GetFldPtr(FBout, trim(FBoutfld), fldptr1=dp1, fldptr2=dp2, rank=lrank, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (merge_type == 'copy_with_weights' .or. merge_type == 'merge' .or. merge_type == 'sum_with_weights') then - if (lrank == 1) then - call shr_nuopc_methods_FB_GetFldPtr(FBw, trim(fldw), fldptr1=dpw1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (lrank == 2) then - call shr_nuopc_methods_FB_GetFldPtr(FBw, trim(fldw), fldptr2=dpw2, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - endif - - !------------------------- - ! Loop over all output fields and do the merge - !------------------------- + ! Get field pointer to output field + call ESMF_FieldBundleGet(FBout, fieldName=trim(FBoutfld), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (lrank == 1) then + call ESMF_FieldGet(lfield, farrayPtr=dp1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else if (lrank == 2) then + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound_output, & + gridToFieldMap=gridToFieldMap_output, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dp2, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if ! Get field pointer to input field used in the merge + call ESMF_FieldBundleGet(FB, fieldName=trim(FBfld), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return if (lrank == 1) then - call shr_nuopc_methods_FB_GetFldPtr(FB, trim(FBfld), fldptr1=dpf1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dpf1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return else if (lrank == 2) then - call shr_nuopc_methods_FB_GetFldPtr(FB, trim(FBfld), fldptr2=dpf2, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound_input, & + gridToFieldMap=gridToFieldMap_input, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dpf2, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if - ! Do one of two types of merges (copy or merge) + ! error checks + if (ungriddedUBound_output(1) /= ungriddedUBound_input(1)) then + call shr_sys_abort("ungriddedUBound_input not equal to ungriddedUBound_output") + else if (gridToFieldMap_input(1) /= gridToFieldMap_output(1)) then + call shr_sys_abort("gridToFieldMap_input not equal to gridToFieldMap_output") + end if + + ! Get pointer to weights that weights are only rank 1 + if (merge_type == 'copy_with_weights' .or. merge_type == 'merge' .or. merge_type == 'sum_with_weights') then + call ESMF_FieldBundleGet(FBw, fieldName=trim(fldw), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dpw1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif + + ! Do supported merges if (trim(merge_type) == 'copy') then if (lrank == 1) then dp1(:) = dpf1(:) @@ -291,13 +316,25 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld if (lrank == 1) then dp1(:) = dpf1(:)*dpw1(:) else - dp2(:,:) = dpf2(:,:)*dpw2(:,:) + do n = 1,ungriddedUBound_input(1) + if (gridToFieldMap_input(1) == 1) then + dp2(:,n) = dpf2(:,n)*dpw1(:) + else if (gridToFieldMap_input(1) == 2) then + dp2(n,:) = dpf2(n,:)*dpw1(:) + end if + end do endif - else if (trim(merge_type) == 'merge') then + else if (trim(merge_type) == 'merge' .or. trim(merge_type) == 'sum_with_weights') then if (lrank == 1) then dp1(:) = dp1(:) + dpf1(:)*dpw1(:) else - dp2(:,:) = dp2(:,:) + dpf2(:,:)*dpw2(:,:) + do n = 1,ungriddedUBound_input(1) + if (gridToFieldMap_input(1) == 1) then + dp2(:,n) = dp2(:,n) + dpf2(:,n)*dpw1(:) + else if (gridToFieldMap_input(1) == 2) then + dp2(n,:) = dp2(n,:) + dpf2(n,:)*dpw1(:) + end if + end do endif else if (trim(merge_type) == 'sum') then if (lrank == 1) then @@ -305,15 +342,9 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld else dp2(:,:) = dp2(:,:) + dpf2(:,:) endif - else if (trim(merge_type) == 'sum_with_weights') then - if (lrank == 1) then - dp1(:) = dp1(:) + dpf1(:)*dpw1(:) - else - dp2(:,:) = dp2(:,:) + dpf2(:,:)*dpw2(:,:) - endif else call ESMF_LogWrite(trim(subname)//": merge type "//trim(merge_type)//" not supported", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return end if diff --git a/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 b/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 index 7e284975d808..ef127088cd57 100644 --- a/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 @@ -2,7 +2,7 @@ module med_phases_aofluxes_mod use med_constants_mod , only : R8, CL, CX use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use med_internalstate_mod , only : mastertask + use med_internalstate_mod , only : mastertask, logunit use shr_nuopc_utils_mod , only : shr_nuopc_memcheck use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_chkerr use shr_nuopc_methods_mod , only : fldchk => shr_nuopc_methods_FB_FldChk @@ -20,7 +20,6 @@ module med_phases_aofluxes_mod ! Private routines !-------------------------------------------------------------------------- - private :: med_phases_aofluxes_init private :: med_aofluxes_init private :: med_aofluxes_run @@ -72,118 +71,33 @@ module med_phases_aofluxes_mod ! Fields that are not obtained via GetFldPtr real(R8) , pointer :: uGust (:) ! wind gust + logical :: created ! has this data type been created end type aoflux_type ! The following three variables are obtained as attributes from gcomp logical :: flds_wiso ! use case logical :: compute_atm_dens logical :: compute_atm_thbot - character(3) :: aoflux_grid character(*), parameter :: u_FILE_u = & __FILE__ !================================================================================ contains -!================================================================================ - - subroutine med_phases_aofluxes_init(gcomp, aoflux, rc) - - use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_VMGet, ESMF_GridCompGet - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGERR_PASSTHRU - use ESMF , only : ESMF_SUCCESS, ESMF_LogFoundError - use NUOPC , only : NUOPC_CompAttributeGet - use esmFlds , only : compatm, compocn - use med_internalstate_mod , only : InternalState, mastertask - use shr_nuopc_scalars_mod , only : flds_scalar_name - use shr_nuopc_scalars_mod , only : flds_scalar_num - use perf_mod , only : t_startf, t_stopf - - !----------------------------------------------------------------------- - ! Initialize ocn/atm flux calculations - !----------------------------------------------------------------------- - - ! input/output variables - type(ESMF_GridComp) :: gcomp - type(aoflux_type) , intent(inout) :: aoflux - integer , intent(out) :: rc - - ! Local variables - character(3) :: aoflux_grid - character(len=256) :: cvalue - type(InternalState) :: is_local - integer :: localPet - type(ESMF_VM) :: vm - integer :: dbrc - character(len=*),parameter :: subname='(med_phases_aofluxes_init)' - !--------------------------------------- - call t_startf('MED:'//subname) - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - call ESMF_VMGet(vm, localPet=localPet, rc=rc) - mastertask = .false. - if (localPet == 0) mastertask=.true. - - ! Get the internal state from Component. - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Determine src and dst comps depending on the aoflux_grid setting - - call NUOPC_CompAttributeGet(gcomp, name='aoflux_grid', value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) aoflux_grid - - if (trim(aoflux_grid) == 'ocn') then - - ! Create FBMed_aoflux_o (field bundle on the ocean grid) - call med_aofluxes_init(gcomp, aoflux, & - FBAtm=is_local%wrap%FBImp(compatm,compocn), & - FBOcn=is_local%wrap%FBImp(compocn,compocn), & - FBFrac=is_local%wrap%FBfrac(compocn), & - FBMed_aoflux=is_local%wrap%FBMed_aoflux_o, & - rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - else if (trim(aoflux_grid) == 'atm') then - - ! Create FBMed_aoflux_a (field bundle on the atmosphere grid) - call med_aofluxes_init(gcomp, aoflux, & - FBAtm=is_local%wrap%FBImp(compatm,compatm), & - FBOcn=is_local%wrap%FBImp(compocn,compatm), & - FBFrac=is_local%wrap%FBfrac(compatm), & - FBMed_aoflux=is_local%wrap%FBMed_aoflux_a, & - rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - else - - call ESMF_LogWrite(trim(subname)//' aoflux_grid = '//trim(aoflux_grid)//' not available', & - ESMF_LOGMSG_INFO, rc=dbrc) - return - - end if - call t_stopf('MED:'//subname) - - end subroutine med_phases_aofluxes_init - !================================================================================ subroutine med_phases_aofluxes_run(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_GridCompGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FieldBundleIsCreated use NUOPC , only : NUOPC_IsConnected, NUOPC_CompAttributeGet use med_internalstate_mod , only : InternalState use med_map_mod , only : med_map_FB_Regrid_Norm - use esmFlds , only : fldListFr - use esmFlds , only : compatm, compocn, compname + use esmFlds , only : shr_nuopc_fldList_GetNumFlds, shr_nuopc_fldList_GetFldNames + use esmFlds , only : fldListFr, fldListMed_aoflux, compatm, compocn, compname use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_init + use shr_nuopc_scalars_mod , only : flds_scalar_name use perf_mod , only : t_startf, t_stopf !----------------------------------------------------------------------- @@ -196,101 +110,77 @@ subroutine med_phases_aofluxes_run(gcomp, rc) ! local variables type(InternalState) :: is_local - type(ESMF_Clock) :: clock - character(CL) :: cvalue - character(CL) :: aoflux_grid type(aoflux_type), save :: aoflux logical, save :: first_call = .true. - integer :: dbrc character(len=*),parameter :: subname='(med_phases_aofluxes)' !--------------------------------------- - call t_startf('MED:'//subname) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif rc = ESMF_SUCCESS - call shr_nuopc_memcheck(subname, 5, mastertask) - ! Get the clock from the mediator Component - call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return ! Get the internal state from the mediator Component. nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Initialize aoflux instance if (first_call) then - call med_phases_aofluxes_init(gcomp, aoflux, rc) - first_call = .false. - end if - - ! Determine source and destination comps depending on the aoflux_grid setting - call NUOPC_CompAttributeGet(gcomp, name='aoflux_grid', value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) aoflux_grid - - if (trim(aoflux_grid) == 'ocn') then - - ! TODO(mvertens, 2019-01-12): ONLY regrid atm import fields that are needed for the atm/ocn flux calculation - - ! Regrid atm import field bundle from atm to ocn grid as input for ocn/atm flux calculation - call med_map_FB_Regrid_Norm( & - fldListFr(compatm)%flds, compatm, compocn, & - is_local%wrap%FBImp(compatm,compatm), & - is_local%wrap%FBImp(compatm,compocn), & - is_local%wrap%FBFrac(compatm), & - is_local%wrap%FBNormOne(compatm,compocn,:), & - is_local%wrap%RH(compatm,compocn,:), & - string=trim(compname(compatm))//'2'//trim(compname(compocn)), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Calculate atm/ocn fluxes on the destination grid - call med_aofluxes_run(gcomp, aoflux, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (dbug_flag > 1) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBMed_aoflux_o, & - string=trim(subname) //' FBAMed_aoflux_o' , rc=rc) + ! If field bundles have been created for the ocean/atmosphere flux computation + if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .and. & + ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then + + ! Allocate memoroy for the aoflux module data type (mediator atm/ocn field bundle on the ocean grid) + call med_aofluxes_init(gcomp, aoflux, & + FBAtm=is_local%wrap%FBImp(compatm,compocn), & + FBOcn=is_local%wrap%FBImp(compocn,compocn), & + FBFrac=is_local%wrap%FBfrac(compocn), & + FBMed_aoflux=is_local%wrap%FBMed_aoflux_o, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + aoflux%created = .true. + else + aoflux%created = .false. end if - else if (trim(aoflux_grid) == 'atm') then + ! Now set first_call to .false. + first_call = .false. + end if - call med_map_FB_Regrid_Norm( & - fldListFr(compocn)%flds, compocn, compatm, & - is_local%wrap%FBImp(compocn,compocn), & - is_local%wrap%FBImp(compocn,compatm), & - is_local%wrap%FBFrac(compocn), & - is_local%wrap%FBNormOne(compocn,compatm,:), & - is_local%wrap%RH(compocn,compatm,:), & - string=trim(compname(compocn))//'2'//trim(compname(compatm)), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Return if there is no aoflux has not been created + if (.not. aoflux%created) then + RETURN + end if - if (dbug_flag > 1) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBImp(compocn,compatm), & - string=trim(subname) //' FBImp('//trim(compname(compocn))//','//trim(compname(compatm))//') ', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + ! Start time timer + call t_startf('MED:'//subname) - ! Calculate atm/ocn fluxes on the destination grid - call med_aofluxes_run(gcomp, aoflux, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif - if (dbug_flag > 1) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBImp(compocn,compatm), & - string=trim(subname) //' FBImp('//trim(compname(compocn))//','//trim(compname(compatm))//') ', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + call shr_nuopc_memcheck(subname, 5, mastertask) - else + ! TODO(mvertens, 2019-01-12): ONLY regrid atm import fields that are needed for the atm/ocn flux calculation + + ! Regrid atm import field bundle from atm to ocn grid as input for ocn/atm flux calculation + call med_map_FB_Regrid_Norm( & + fldListFr(compatm)%flds, compatm, compocn, & + is_local%wrap%FBImp(compatm,compatm), & + is_local%wrap%FBImp(compatm,compocn), & + is_local%wrap%FBFrac(compatm), & + is_local%wrap%FBFrac(compocn), & + is_local%wrap%FBNormOne(compatm,compocn,:), & + is_local%wrap%RH(compatm,compocn,:), & + string=trim(compname(compatm))//'2'//trim(compname(compocn)), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//' aoflux_grid = '//trim(aoflux_grid)//' not available', & - ESMF_LOGMSG_INFO, rc=dbrc) - return + ! Calculate atm/ocn fluxes on the destination grid + call med_aofluxes_run(gcomp, aoflux, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBMed_aoflux_o, & + string=trim(subname) //' FBAMed_aoflux_o' , rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if + call t_stopf('MED:'//subname) end subroutine med_phases_aofluxes_run @@ -321,7 +211,6 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, integer , intent(out) :: rc ! local variables - type(ESMF_VM) :: vm integer :: iam integer :: n integer :: lsize @@ -329,23 +218,15 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, real(R8), pointer :: ifrac(:) character(CL) :: cvalue logical :: flds_wiso ! use case - integer :: dbrc character(len=CX) :: tmpstr character(*),parameter :: subName = '(med_aofluxes_init) ' !----------------------------------------------------------------------- - call t_startf('MED:'//subname) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS call shr_nuopc_memcheck(subname, 5, mastertask) - ! The following is for debugging - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localPet=iam, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return !---------------------------------- ! get attributes that are set as module variables @@ -355,10 +236,6 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return read(cvalue,*) flds_wiso - call NUOPC_CompAttributeGet(gcomp, name='aoflux_grid', value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) aoflux_grid - !---------------------------------- ! atm/ocn fields !---------------------------------- @@ -524,7 +401,7 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, ! where (ofrac(:) + ifrac(:) <= 0.0_R8) mask(:) = 0 if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif call t_stopf('MED:'//subname) @@ -564,6 +441,7 @@ subroutine med_aofluxes_run(gcomp, aoflux, rc) logical,save :: first_call = .true. character(*),parameter :: subName = '(med_aofluxes_run) ' !----------------------------------------------------------------------- + call t_startf('MED:'//subname) !---------------------------------- diff --git a/src/drivers/nuopc/mediator/med_phases_history_mod.F90 b/src/drivers/nuopc/mediator/med_phases_history_mod.F90 index e118555fe1b0..be58ec543ece 100644 --- a/src/drivers/nuopc/mediator/med_phases_history_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_history_mod.F90 @@ -45,16 +45,15 @@ subroutine med_phases_history_write(gcomp, rc) use shr_nuopc_time_mod , only : shr_nuopc_time_alarmInit use med_constants_mod , only : dbug_flag =>med_constants_dbug_flag use med_constants_mod , only : SecPerDay =>med_constants_SecPerDay - use med_constants_mod , only : R8, CL, CS, IN + use med_constants_mod , only : R8, CL, CS use med_constants_mod , only : med_constants_noleap, med_constants_gregorian - use med_infodata_mod , only : med_infodata, med_infodata_GetData use med_map_mod , only : med_map_FB_Regrid_Norm use med_internalstate_mod , only : InternalState, mastertask use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef - use med_io_mod , only : med_io_close, med_io_date2yyyymmdd - use med_io_mod , only : med_io_sec2hms + use med_io_mod , only : med_io_close, med_io_date2yyyymmdd, med_io_sec2hms use perf_mod , only : t_startf, t_stopf - ! Input/output variables + + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -276,13 +275,15 @@ subroutine med_phases_history_write(gcomp, rc) do n = 1,ncomps if (is_local%wrap%comp_present(n)) then if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - call med_infodata_GetData(med_infodata, ncomp=n, nx=nx, ny=ny) + nx = is_local%wrap%nx(n) + ny = is_local%wrap%ny(n) call med_io_write(hist_file, iam, is_local%wrap%FBimp(n,n), & nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Imp', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return endif if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then - call med_infodata_GetData(med_infodata, ncomp=n, nx=nx, ny=ny) + nx = is_local%wrap%nx(n) + ny = is_local%wrap%ny(n) call med_io_write(hist_file, iam, is_local%wrap%FBexp(n), & nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Exp', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/drivers/nuopc/mediator/med_phases_ocnalb_mod.F90 b/src/drivers/nuopc/mediator/med_phases_ocnalb_mod.F90 index 9f07eac4e4e6..e9b01e4de9dc 100644 --- a/src/drivers/nuopc/mediator/med_phases_ocnalb_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_ocnalb_mod.F90 @@ -30,6 +30,7 @@ module med_phases_ocnalb_mod real(r8) , pointer :: avsdr (:) ! albedo: visible , direct real(r8) , pointer :: anidf (:) ! albedo: near infrared, diffuse real(r8) , pointer :: avsdf (:) ! albedo: visible , diffuse + logical :: created ! has memory been allocated here end type ocnalb_type ! Conversion from degrees to radians @@ -178,7 +179,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time, ESMF_TimeInterval use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LogFoundError - use ESMF , only : ESMF_RouteHandleIsCreated + use ESMF , only : ESMF_RouteHandleIsCreated, ESMF_FieldBundleIsCreated use ESMF , only : operator(+) use NUOPC , only : NUOPC_CompAttributeGet use shr_const_mod , only : shr_const_pi @@ -198,6 +199,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) use shr_nuopc_scalars_mod , only : flds_scalar_index_nextsw_cday use esmFlds , only : compatm, compocn use perf_mod , only : t_startf, t_stopf + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -238,10 +240,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) logical :: first_call = .true. character(len=*) , parameter :: subname='(med_phases_ocnalb_run)' !--------------------------------------- - call t_startf('MED:'//subname) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + rc = ESMF_SUCCESS ! Get the internal state from Component. @@ -249,14 +248,32 @@ subroutine med_phases_ocnalb_run(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + ! Determine if ocnalb data type will be initialized - and if not return + if (first_call) then + if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .and. & + ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then + ocnalb%created = .true. + else + ocnalb%created = .false. + end if + end if + if (.not. ocnalb%created) then + return + end if + ! Note that in the mct version the atm was initialized first so ! that nextsw_cday could be passed to the other components - this ! assumed that atmosphere component was ALWAYS initialized first. ! In the nuopc version it will be easier to assume that on startup ! - nextsw_cday is just what cam was setting it as the current calendar day - if (first_call) then + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + call t_startf('MED:'//subname) + if (first_call) then ! Initialize ocean albedo calculation call med_phases_ocnalb_init(gcomp, ocnalb, rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return @@ -284,9 +301,9 @@ subroutine med_phases_ocnalb_run(gcomp, rc) call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return else - call shr_nuopc_methods_State_GetScalar(is_local%wrap%NstateImp(compatm), & + call shr_nuopc_methods_State_GetScalar(state=is_local%wrap%NstateImp(compatm), & flds_scalar_name=flds_scalar_name, flds_scalar_num=flds_scalar_num, & - scalar_id=flds_scalar_index_nextsw_cday, value=nextsw_cday, rc=rc) + scalar_id=flds_scalar_index_nextsw_cday, scalar_value=nextsw_cday, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return end if @@ -295,9 +312,9 @@ subroutine med_phases_ocnalb_run(gcomp, rc) else ! Note that shr_nuopc_methods_State_GetScalar includes a broadcast to all other pets - call shr_nuopc_methods_State_GetScalar(is_local%wrap%NstateImp(compatm), & + call shr_nuopc_methods_State_GetScalar(state=is_local%wrap%NstateImp(compatm), & flds_scalar_name=flds_scalar_name, flds_scalar_num=flds_scalar_num, & - scalar_id=flds_scalar_index_nextsw_cday, value=nextsw_cday, rc=rc) + scalar_id=flds_scalar_index_nextsw_cday, scalar_value=nextsw_cday, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return end if @@ -378,7 +395,8 @@ subroutine med_phases_ocnalb_run(gcomp, rc) endif if (dbug_flag > 1) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBMed_ocnalb_o, string=trim(subname)//' FBMed_ocnalb_o', rc=rc) + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBMed_ocnalb_o, & + string=trim(subname)//' FBMed_ocnalb_o', rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return end if call t_stopf('MED:'//subname) @@ -430,6 +448,7 @@ subroutine med_phases_ocnalb_mapo2a(gcomp, rc) is_local%wrap%FBMed_ocnalb_o, & is_local%wrap%FBMed_ocnalb_a, & is_local%wrap%FBFrac(compocn), & + is_local%wrap%FBFrac(compatm), & is_local%wrap%FBNormOne(compocn,compatm,:), & is_local%wrap%RH(compocn,compatm,:), & string='FBMed_ocnalb_o_To_FBMed_ocnalb_a', rc=rc) diff --git a/src/drivers/nuopc/mediator/med_phases_prep_atm_mod.F90 b/src/drivers/nuopc/mediator/med_phases_prep_atm_mod.F90 index d645fd6007f2..ba91ff76a302 100644 --- a/src/drivers/nuopc/mediator/med_phases_prep_atm_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_prep_atm_mod.F90 @@ -1,7 +1,7 @@ module med_phases_prep_atm_mod !----------------------------------------------------------------------------- - ! Mediator Phase + ! Mediator phases for preparing atm export from mediator !----------------------------------------------------------------------------- implicit none @@ -9,7 +9,7 @@ module med_phases_prep_atm_mod public :: med_phases_prep_atm - character(*) , parameter :: u_FILE_u = & + character(*), parameter :: u_FILE_u = & __FILE__ !----------------------------------------------------------------------------- @@ -18,8 +18,6 @@ module med_phases_prep_atm_mod subroutine med_phases_prep_atm(gcomp, rc) - ! Prepares the ATM import Fields. - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_FieldBundleGet, ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time, ESMF_ClockPrint @@ -53,16 +51,18 @@ subroutine med_phases_prep_atm(gcomp, rc) type(InternalState) :: is_local real(R8), pointer :: dataPtr1(:),dataPtr2(:) integer :: i, j, n, n1, ncnt - logical,save :: first_call = .true. integer :: dbrc character(len=*),parameter :: subname='(med_phases_prep_atm)' !------------------------------------------------------------------------------- call t_startf('MED:'//subname) - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) - call shr_nuopc_memcheck(subname, 3, mastertask) rc = ESMF_SUCCESS + if (dbug_flag > 5) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + end if + call shr_nuopc_memcheck(subname, 3, mastertask) + !--------------------------------------- ! --- Get the internal state !--------------------------------------- @@ -114,6 +114,7 @@ subroutine med_phases_prep_atm(gcomp, rc) is_local%wrap%FBImp(n1,n1), & is_local%wrap%FBImp(n1,compatm), & is_local%wrap%FBFrac(n1), & + is_local%wrap%FBFrac(compatm), & is_local%wrap%FBNormOne(n1,compatm,:), & is_local%wrap%RH(n1,compatm,:), & string=trim(compname(n1))//'2'//trim(compname(compatm)), rc=rc) @@ -139,6 +140,7 @@ subroutine med_phases_prep_atm(gcomp, rc) is_local%wrap%FBMed_aoflux_o, & is_local%wrap%FBMed_aoflux_a, & is_local%wrap%FBFrac(compocn), & + is_local%wrap%FBFrac(compatm), & is_local%wrap%FBNormOne(compocn,compatm,:), & is_local%wrap%RH(compocn,compatm,:), & string='FBMed_aoflux_o_To_FBMEd_aoflux_a', rc=rc) @@ -153,26 +155,26 @@ subroutine med_phases_prep_atm(gcomp, rc) is_local%wrap%FBExp(compatm), is_local%wrap%FBFrac(compatm), & is_local%wrap%FBImp(:,compatm), fldListTo(compatm), & FBMed1=is_local%wrap%FBMed_ocnalb_a, & - FBMed2=is_local%wrap%FBMed_aoflux_a, & - document=first_call, string='(merge_to_atm)', mastertask=mastertask, rc=rc) + FBMed2=is_local%wrap%FBMed_aoflux_a, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'nems_orig') then call med_merge_auto(trim(compname(compatm)), & is_local%wrap%FBExp(compatm), is_local%wrap%FBFrac(compatm), & is_local%wrap%FBImp(:,compatm), fldListTo(compatm), & - FBMed1=is_local%wrap%FBMed_aoflux_a, & - document=first_call, string='(merge_to_atm)', mastertask=mastertask, rc=rc) + FBMed1=is_local%wrap%FBMed_aoflux_a, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'nems_frac') then call med_merge_auto(trim(compname(compatm)), & is_local%wrap%FBExp(compatm), is_local%wrap%FBFrac(compatm), & - is_local%wrap%FBImp(:,compatm), fldListTo(compatm), & - document=first_call, string='(merge_to_atm)', mastertask=mastertask, rc=rc) + is_local%wrap%FBImp(:,compatm), fldListTo(compatm), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compatm), string=trim(subname)//' FBexp(compatm) ', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compatm), & + string=trim(subname)//' FBexp(compatm) ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if !--------------------------------------- !--- custom calculations @@ -217,10 +219,11 @@ subroutine med_phases_prep_atm(gcomp, rc) !--- clean up !--------------------------------------- - first_call = .false. endif - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + end if call t_stopf('MED:'//subname) end subroutine med_phases_prep_atm diff --git a/src/drivers/nuopc/mediator/med_phases_prep_glc_mod.F90 b/src/drivers/nuopc/mediator/med_phases_prep_glc_mod.F90 index 524b87b63539..d6cba2895f27 100644 --- a/src/drivers/nuopc/mediator/med_phases_prep_glc_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_prep_glc_mod.F90 @@ -1,34 +1,38 @@ module med_phases_prep_glc_mod !----------------------------------------------------------------------------- - ! Mediator Phases + ! Mediator phases for preparing glc export from mediator !----------------------------------------------------------------------------- implicit none private - character(*) , parameter :: u_FILE_u = __FILE__ - public :: med_phases_prep_glc + character(*), parameter :: u_FILE_u = & + __FILE__ + !----------------------------------------------------------------------------- contains !----------------------------------------------------------------------------- subroutine med_phases_prep_glc(gcomp, rc) - use ESMF, only : ESMF_GridComp, ESMF_Clock, ESMF_Time - use ESMF, only: ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF, only: ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet, ESMF_ClockPrint - use ESMF, only: ESMF_FieldBundleGet - use esmFlds , only : compglc, ncomps, compname - use esmFlds , only : fldListFr, fldListTo - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose - use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag - use med_merge_mod , only : med_merge_auto - use med_map_mod , only : med_map_FB_Regrid_Norm - use med_internalstate_mod , only : InternalState, mastertask - use perf_mod , only : t_startf, t_stopf + + use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time + use ESMF , only: ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only: ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet, ESMF_ClockPrint + use ESMF , only: ESMF_FieldBundleGet + use esmFlds , only : compglc, ncomps, compname + use esmFlds , only : fldListFr, fldListTo + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getNumFlds + use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag + use med_merge_mod , only : med_merge_auto + use med_map_mod , only : med_map_FB_Regrid_Norm + use med_internalstate_mod , only : InternalState, mastertask + use perf_mod , only : t_startf, t_stopf + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -40,12 +44,14 @@ subroutine med_phases_prep_glc(gcomp, rc) character(len=64) :: timestr type(InternalState) :: is_local integer :: i,j,n,n1,ncnt - logical,save :: first_call = .true. + integer :: dbrc character(len=*),parameter :: subname='(med_phases_prep_glc)' - integer :: dbrc !--------------------------------------- + call t_startf('MED:'//subname) - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + end if rc = ESMF_SUCCESS !--------------------------------------- @@ -57,21 +63,16 @@ subroutine med_phases_prep_glc(gcomp, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- - !--- Count the number of fields outside of scalar data, if zero, then return + ! --- Count the number of fields outside of scalar data, if zero, then return !--------------------------------------- ! Note - the scalar field has been removed from all mediator field bundles - so this is why we check if the ! fieldCount is 0 and not 1 here - call ESMF_FieldBundleGet(is_local%wrap%FBExp(compglc), fieldCount=ncnt, rc=rc) + call shr_nuopc_methods_FB_getNumFlds(is_local%wrap%FBExp(compglc), trim(subname)//"FBexp(compglc)", ncnt, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (ncnt == 0) then - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": only scalar data is present in FBexp(compglc), returning", & - ESMF_LOGMSG_INFO, rc=dbrc) - endif - else + if (ncnt > 0) then !--------------------------------------- !--- Get the current time from the clock @@ -95,7 +96,7 @@ subroutine med_phases_prep_glc(gcomp, rc) end if !--------------------------------------- - !--- mapping + !--- map to create FBimp(:,compglc) !--------------------------------------- do n1 = 1,ncomps @@ -105,6 +106,7 @@ subroutine med_phases_prep_glc(gcomp, rc) is_local%wrap%FBImp(n1,n1), & is_local%wrap%FBImp(n1,compglc), & is_local%wrap%FBFrac(n1), & + is_local%wrap%FBFrac(compglc), & is_local%wrap%FBNormOne(n1,compglc,:), & is_local%wrap%RH(n1,compglc,:), & string=trim(compname(n1))//'2'//trim(compname(compglc)), rc=rc) @@ -113,19 +115,21 @@ subroutine med_phases_prep_glc(gcomp, rc) enddo !--------------------------------------- - !--- auto merges + !--- auto merges to create FBExp(compglc) !--------------------------------------- call med_merge_auto(trim(compname(compglc)), & - is_local%wrap%FBExp(compglc), is_local%wrap%FBFrac(compglc), & - is_local%wrap%FBImp(:,compglc), fldListTo(compglc), & - document=first_call, string='(merge_to_lnd)', mastertask=mastertask, rc=rc) + is_local%wrap%FBExp(compglc), & + is_local%wrap%FBFrac(compglc), & + is_local%wrap%FBImp(:,compglc), & + fldListTo(compglc), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compglc), string=trim(subname)//' FBexp(compglc) ', rc=rc) + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compglc), & + string=trim(subname)//' FBexp(compglc) ', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif + end if !--------------------------------------- !--- custom calculations @@ -141,9 +145,11 @@ subroutine med_phases_prep_glc(gcomp, rc) !--- clean up !--------------------------------------- - first_call = .false. endif - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + end if call t_stopf('MED:'//subname) end subroutine med_phases_prep_glc diff --git a/src/drivers/nuopc/mediator/med_phases_prep_ice_mod.F90 b/src/drivers/nuopc/mediator/med_phases_prep_ice_mod.F90 index 98fb9a85a54a..a991b84b583f 100644 --- a/src/drivers/nuopc/mediator/med_phases_prep_ice_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_prep_ice_mod.F90 @@ -1,7 +1,7 @@ module med_phases_prep_ice_mod !----------------------------------------------------------------------------- - ! Mediator Phases + ! Mediator phases for preparing ice export from mediator !----------------------------------------------------------------------------- implicit none @@ -12,30 +12,32 @@ module med_phases_prep_ice_mod public :: med_phases_prep_ice !----------------------------------------------------------------------------- - contains +contains !----------------------------------------------------------------------------- subroutine med_phases_prep_ice(gcomp, rc) - ! Prepares the ICE import Fields. - - use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet, ESMF_ClockPrint use ESMF , only : ESMF_FieldBundleGet, ESMF_RouteHandleIsCreated use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE use NUOPC , only : NUOPC_IsConnected - use med_constants_mod , only : CL, CS, R8 use esmFlds , only : compatm, compice, comprof, compglc, ncomps, compname use esmFlds , only : fldListFr, fldListTo use esmFlds , only : mapbilnr + use shr_nuopc_methods_mod , only : fldchk => shr_nuopc_methods_FB_FldChk use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_reset use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_GetFldPtr + use shr_nuopc_methods_mod , only : FB_GetFldPtr => shr_nuopc_methods_FB_GetFldPtr use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FldChk use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FieldRegrid - use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getNumFlds + use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_GetScalar + use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar + use shr_nuopc_scalars_mod , only : flds_scalar_name, flds_scalar_num + use shr_nuopc_scalars_mod , only : flds_scalar_index_nextsw_cday + use med_constants_mod , only : CS, R8, dbug_flag=>med_constants_dbug_flag use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_FB_Regrid_Norm use med_internalstate_mod , only : InternalState, logunit, mastertask @@ -46,31 +48,28 @@ subroutine med_phases_prep_ice(gcomp, rc) integer, intent(out) :: rc ! local variables - type(ESMF_Clock) :: clock - type(ESMF_Time) :: time - character(len=64) :: timestr - type(InternalState) :: is_local - real(R8), pointer :: dataPtr1(:) - integer :: i,n,n1,ncnt - character(len=CS) :: fldname - real(R8), pointer :: dataptr(:) - real(R8), pointer :: temperature(:) - real(R8), pointer :: pressure(:) - real(R8), pointer :: humidity(:) - real(R8), pointer :: air_density(:) - real(R8), pointer :: pot_temp(:) - character(len=1024) :: msgString - ! TODO: the calculation needs to be set at run time based on receiving it from the ocean - real(R8) :: flux_epbalfact = 1._R8 - logical,save :: first_call = .true. - integer :: dbrc - character(len=*),parameter :: subname='(med_phases_prep_ice)' + character(len=64) :: timestr + type(InternalState) :: is_local + integer :: i,n,n1,ncnt + character(len=CS) :: fldname + real(R8), pointer :: dataptr(:) + real(R8), pointer :: temperature(:) + real(R8), pointer :: pressure(:) + real(R8), pointer :: humidity(:) + real(R8), pointer :: air_density(:) + real(R8), pointer :: pot_temp(:) + real(R8) :: precip_fact + character(len=CS) :: cvalue + character(len=64), allocatable :: fldnames(:) + real(r8) :: nextsw_cday + logical :: first_precip_fact_call = .true. + character(len=*),parameter :: subname='(med_phases_prep_ice)' !--------------------------------------- call t_startf('MED:'//subname) if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -89,169 +88,160 @@ subroutine med_phases_prep_ice(gcomp, rc) ! Note - the scalar field has been removed from all mediator field bundles - so this is why we check if the ! fieldCount is 0 and not 1 here - call ESMF_FieldBundleGet(is_local%wrap%FBExp(compice), fieldCount=ncnt, rc=rc) + call shr_nuopc_methods_FB_getNumFlds(is_local%wrap%FBExp(compice), trim(subname)//"FBexp(compice)", ncnt, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (ncnt == 0) then - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": only scalar data is present in FBexp(compice), returning", & - ESMF_LOGMSG_INFO, rc=dbrc) - endif - RETURN - end if - !--------------------------------------- - !--- Get the current time from the clock - !--------------------------------------- + if (ncnt > 0) then + + !--------------------------------------- + !--- map to create FBImp(:,compice) + !--------------------------------------- + + do n1 = 1,ncomps + if (is_local%wrap%med_coupling_active(n1,compice)) then + call med_map_FB_Regrid_Norm( & + fldListFr(n1)%flds, n1, compice, & + is_local%wrap%FBImp(n1,n1), & + is_local%wrap%FBImp(n1,compice), & + is_local%wrap%FBFrac(n1), & + is_local%wrap%FBFrac(compice), & + is_local%wrap%FBNormOne(n1,compice,:), & + is_local%wrap%RH(n1,compice,:), & + string=trim(compname(n1))//'2'//trim(compname(compice)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + enddo - call ESMF_GridCompGet(gcomp, clock=clock) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(clock,currtime=time,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(time,timestring=timestr) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": time = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) - endif -#if DEBUG - if (mastertask) then - call ESMF_ClockPrint(clock, options="currTime", preString="-------->"//trim(subname)//" mediating for: ", rc=rc) + !--------------------------------------- + !--- auto merges to create FBExp(compice) + !--------------------------------------- + + call med_merge_auto(trim(compname(compice)), & + is_local%wrap%FBExp(compice), is_local%wrap%FBFrac(compice), & + is_local%wrap%FBImp(:,compice), fldListTo(compice), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if -#endif - !--------------------------------------- - !--- map to create FBimp(:,compice) - !--------------------------------------- - do n1 = 1,ncomps - if (is_local%wrap%med_coupling_active(n1,compice)) then - call med_map_FB_Regrid_Norm( & - fldListFr(n1)%flds, n1, compice, & - is_local%wrap%FBImp(n1,n1), & - is_local%wrap%FBImp(n1,compice), & - is_local%wrap%FBFrac(n1), & - is_local%wrap%FBNormOne(n1,compice,:), & - is_local%wrap%RH(n1,compice,:), & - string=trim(compname(n1))//'2'//trim(compname(compice)), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - enddo + !--------------------------------------- + !--- custom calculations + !--------------------------------------- - !--------------------------------------- - !--- auto merges - !--------------------------------------- + ! application of precipitation factor from ocean - call med_merge_auto(trim(compname(compice)), & - is_local%wrap%FBExp(compice), is_local%wrap%FBFrac(compice), & - is_local%wrap%FBImp(:,compice), fldListTo(compice), & - document=first_call, string='(merge_to_ice)', mastertask=mastertask, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! TODO (mvertens, 2019-03-18): precip_fact here is not valid if + ! the component does not send it - hardwire it to 1 until this is resolved + precip_fact = 1.0_R8 - !--------------------------------------- - !--- custom calculations - !--------------------------------------- + if (precip_fact /= 1.0_R8) then + if (first_precip_fact_call .and. mastertask) then + write(logunit,'(a)')'(merge_to_ice): Scaling rain, snow, liquid and ice runoff by precip_fact ' + first_precip_fact_call = .false. + end if + write(cvalue,*) precip_fact + call ESMF_LogWrite(trim(subname)//" precip_fact is "//trim(cvalue), ESMF_LOGMSG_INFO) + + allocate(fldnames(3)) + fldnames = (/'Faxa_rain', 'Faxa_snow', 'Fixx_rofi'/) + do n = 1,size(fldnames) + if (fldchk(is_local%wrap%FBExp(compice), trim(fldnames(n)), rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compice), trim(fldnames(n)) , dataptr, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + dataptr(:) = dataptr(:) * precip_fact + end if + end do + deallocate(fldnames) + end if - ! If either air density or ptem from atm is not available - then need to remp pbot since it will be - ! required for either calculation - if ( .not. shr_nuopc_methods_FB_FldChk(is_local%wrap%FBImp(compatm,compatm), 'Sa_dens',rc=rc) .or. & - .not. shr_nuopc_methods_FB_FldChk(is_local%wrap%FBImp(compatm,compatm), 'Sa_ptem',rc=rc)) then - - ! Determine Sa_pbot on the ice grid and get a pointer to it - if (.not. shr_nuopc_methods_FB_FldChk(is_local%wrap%FBExp(compice), 'Sa_pbot',rc=rc)) then - if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(compatm,compice,mapbilnr))) then - call ESMF_LogWrite(trim(subname)//": ERROR bilinr RH not available for atm->ice", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) - rc = ESMF_FAILURE - return + ! If either air density or ptem from atm is not available - then need pbot since it will be + ! required for either calculation + if ( .not. fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_dens',rc=rc) .or. & + .not. fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_ptem',rc=rc)) then + + ! Determine Sa_pbot on the ice grid and get a pointer to it + if (.not. fldchk(is_local%wrap%FBExp(compice), 'Sa_pbot',rc=rc)) then + if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(compatm,compice,mapbilnr))) then + call ESMF_LogWrite(trim(subname)//": ERROR bilinr RH not available for atm->ice", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + end if + call shr_nuopc_methods_FB_FieldRegrid( & + is_local%wrap%FBImp(compatm,compatm), 'Sa_pbot', & + is_local%wrap%FBImp(compatm,compice), 'Sa_pbot', & + is_local%wrap%RH(compatm,compice,mapbilnr), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if - call shr_nuopc_methods_FB_FieldRegrid( & - is_local%wrap%FBImp(compatm,compatm), 'Sa_pbot', & - is_local%wrap%FBImp(compatm,compice), 'Sa_pbot', & - is_local%wrap%RH(compatm,compice,mapbilnr), rc=rc) + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compice), 'Sa_pbot', pressure, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBImp(compatm,compice), 'Sa_pbot', pressure, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! Get a pointer to Sa_tbot on the ice grid - call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBImp(compatm,compice), 'Sa_tbot', temperature, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - ! compute air density as a custom calculation - if ( .not. shr_nuopc_methods_FB_FldChk(is_local%wrap%FBImp(compatm,compatm), 'Sa_dens',rc=rc)) then - call ESMF_LogWrite(trim(subname)//": computing air density as a custom calculation", ESMF_LOGMSG_INFO, rc=dbrc) + ! Get a pointer to Sa_tbot on the ice grid + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compice), 'Sa_tbot', temperature, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if - call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBImp(compatm,compice), 'Sa_shum', humidity, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBExp(compice), 'Sa_dens', air_density, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! compute air density as a custom calculation + if ( .not. fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_dens',rc=rc)) then + call ESMF_LogWrite(trim(subname)//": computing air density as a custom calculation", ESMF_LOGMSG_INFO) - do n = 1,size(temperature) - if (temperature(n) /= 0._R8) then - air_density(n) = pressure(n) / (287.058_R8*(1._R8 + 0.608_R8*humidity(n))*temperature(n)) - else - air_density(n) = 0._R8 - endif - end do - end if + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compice), 'Sa_shum', humidity, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compice), 'Sa_dens', air_density, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! compute potential temperature as a custom calculation - if (.not. shr_nuopc_methods_FB_FldChk(is_local%wrap%FBImp(compatm,compatm), 'Sa_ptem',rc=rc)) then - call ESMF_LogWrite(trim(subname)//": computing potential temp as a custom calculation", ESMF_LOGMSG_INFO, rc=dbrc) + do n = 1,size(temperature) + if (temperature(n) /= 0._R8) then + air_density(n) = pressure(n) / (287.058_R8*(1._R8 + 0.608_R8*humidity(n))*temperature(n)) + else + air_density(n) = 0._R8 + endif + end do + end if - call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBExp(compice), 'Sa_ptem', pot_temp, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! compute potential temperature as a custom calculation + if (.not. fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_ptem',rc=rc)) then + call ESMF_LogWrite(trim(subname)//": computing potential temp as a custom calculation", ESMF_LOGMSG_INFO) - do n = 1,size(temperature) - pot_temp(n) = temperature(n) * (100000._R8/pressure(n))**0.286_R8 ! Potential temperature (K) - end do - end if + call FB_GetFldPtr(is_local%wrap%FBExp(compice), 'Sa_ptem', pot_temp, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! scale rain, snow and rof to ice by flux_epbalfact - if (shr_nuopc_methods_FB_FldChk(is_local%wrap%FBExp(compice), 'Faxa_rain', rc=rc)) then - call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBExp(compice), 'Faxa_rain' , dataptr1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - dataptr1(:) = dataptr1(:) * flux_epbalfact - if (first_call .and. mastertask) then - write(logunit,'(a)')'(merge_to_ice): Scaling Faxa_rain by flux_epbalfact ' - end if - end if - if (shr_nuopc_methods_FB_FldChk(is_local%wrap%FBExp(compice), 'Faxa_snow', rc=rc)) then - call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBExp(compice), 'Faxa_snow' , dataptr1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - dataptr1(:) = dataptr1(:) * flux_epbalfact - if (first_call .and. mastertask) then - write(logunit,'(a)')'(merge_to_ice): Scaling Faxa_snow by flux_epbalfact ' + do n = 1,size(temperature) + if (pressure(n) /= 0._R8) then + pot_temp(n) = temperature(n) * (100000._R8/pressure(n))**0.286_R8 ! Potential temperature (K) + else + pot_temp(n) = 0._R8 + end if + end do end if - end if - if (shr_nuopc_methods_FB_FldChk(is_local%wrap%FBExp(compice), 'Fixx_rofi', rc=rc)) then - call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBExp(compice), 'Fixx_rofi' , dataptr1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - dataptr1(:) = dataptr1(:) * flux_epbalfact - if (first_call .and. mastertask) then - write(logunit,'(a)')'(merge_to_ice): Scaling Fixx_rofi by flux_epbalfact ' + + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compice), string=trim(subname)//' FBexp(compice) ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if - end if - if (dbug_flag > 1) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compice), string=trim(subname)//' FBexp(compice) ', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif + !--------------------------------------- + !--- update scalar data + !--------------------------------------- - !--------------------------------------- - !--- update local scalar data - !--------------------------------------- + ! send nextsw_cday to land - first obtain it from atm import + call shr_nuopc_methods_State_GetScalar(& + scalar_value=nextsw_cday, scalar_id=flds_scalar_index_nextsw_cday, & + state=is_local%wrap%NstateImp(compatm), flds_scalar_name=flds_scalar_name, & + flds_scalar_num=flds_scalar_num, rc=rc) + if (shr_nuopc_methods_chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_State_SetScalar(& + scalar_value=nextsw_cday, scalar_id=flds_scalar_index_nextsw_cday, & + state=is_local%wrap%NstateExp(compice), flds_scalar_name=flds_scalar_name, & + flds_scalar_num=flds_scalar_num, rc=rc) + if (shr_nuopc_methods_chkerr(rc,__LINE__,u_FILE_u)) return - !is_local%wrap%scalar_data(1) = - !--------------------------------------- - !--- clean up - !--------------------------------------- + !--------------------------------------- + !--- clean up + !--------------------------------------- - first_call = .false. + end if if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif call t_stopf('MED:'//subname) diff --git a/src/drivers/nuopc/mediator/med_phases_prep_lnd_mod.F90 b/src/drivers/nuopc/mediator/med_phases_prep_lnd_mod.F90 index a69fbf256cdb..150d498ff4c6 100644 --- a/src/drivers/nuopc/mediator/med_phases_prep_lnd_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_prep_lnd_mod.F90 @@ -1,7 +1,7 @@ module med_phases_prep_lnd_mod !----------------------------------------------------------------------------- - ! Mediator Phases + ! Mediator phases for preparing land export from mediator !----------------------------------------------------------------------------- implicit none @@ -18,22 +18,24 @@ module med_phases_prep_lnd_mod subroutine med_phases_prep_lnd(gcomp, rc) - ! Prepares the LND import Fields. - use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet, ESMF_ClockPrint use ESMF , only : ESMF_FieldBundleGet - use med_constants_mod , only : CL, CS, CX - use esmFlds , only : complnd, ncomps, compname, comprof + use esmFlds , only : complnd, compatm, ncomps, compname use esmFlds , only : fldListFr, fldListTo use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_init use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose - use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getNumFlds + use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_GetScalar + use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar + use shr_nuopc_scalars_mod , only : flds_scalar_name, flds_scalar_num + use shr_nuopc_scalars_mod , only : flds_scalar_index_nextsw_cday + use med_constants_mod , only : R8, dbug_flag=>med_constants_dbug_flag use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_FB_Regrid_Norm - use med_internalstate_mod , only : InternalState, mastertask + use med_internalstate_mod , only : InternalState use perf_mod , only : t_startf, t_stopf ! input/output variables @@ -41,21 +43,19 @@ subroutine med_phases_prep_lnd(gcomp, rc) integer, intent(out) :: rc ! local variables - type(ESMF_Clock) :: clock - type(ESMF_Time) :: time - character(len=64) :: timestr type(InternalState) :: is_local - integer :: i,j,n,n1,nf,compsrc - integer :: ncnt - integer :: dbrc - logical,save :: first_call = .true. - character(len=*),parameter :: subname='(med_phases_prep_lnd)' + integer :: n1,ncnt + real(r8) :: nextsw_cday + character(len=*), parameter :: subname='(med_phases_prep_lnd)' !--------------------------------------- - call t_startf('MED:'//subname) - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + end if + !--------------------------------------- ! --- Get the internal state !--------------------------------------- @@ -71,32 +71,13 @@ subroutine med_phases_prep_lnd(gcomp, rc) ! Note - the scalar field has been removed from all mediator field bundles - so this is why we check if the ! fieldCount is 0 and not 1 here - call ESMF_FieldBundleGet(is_local%wrap%FBExp(complnd), fieldCount=ncnt, rc=rc) + call shr_nuopc_methods_FB_getNumFlds(is_local%wrap%FBExp(complnd), trim(subname)//"FBexp(complnd)", ncnt, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (ncnt == 0) then - call ESMF_LogWrite(trim(subname)//": only scalar data is present in FBexp(complnd), returning", & - ESMF_LOGMSG_INFO, rc=dbrc) - else + if (ncnt > 0) then !--------------------------------------- - !--- Get the current time from the clock - !--------------------------------------- - - if (mastertask) then - call ESMF_GridCompGet(gcomp, clock=clock) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(clock,currtime=time,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(time,timestring=timestr) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//": time = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) - call ESMF_ClockPrint(clock, options="currTime", preString="-------->"//trim(subname)//" mediating for: ", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - !--------------------------------------- - !--- Map import fields to the complnd grid + !--- map to create FBimp(:,complnd) !--------------------------------------- do n1 = 1,ncomps @@ -106,6 +87,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) is_local%wrap%FBImp(n1,n1), & is_local%wrap%FBImp(n1,complnd), & is_local%wrap%FBFrac(n1), & + is_local%wrap%FBFrac(complnd), & is_local%wrap%FBNormOne(n1,complnd,:), & is_local%wrap%RH(n1,complnd,:), & string=trim(compname(n1))//'2'//trim(compname(complnd)), rc=rc) @@ -114,36 +96,51 @@ subroutine med_phases_prep_lnd(gcomp, rc) enddo !--------------------------------------- - !--- Merge all required import fields on the complnd grid to create FBExp + !--- auto merges to create FBExp(complnd) !--------------------------------------- call med_merge_auto(trim(compname(complnd)), & - is_local%wrap%FBExp(complnd), is_local%wrap%FBFrac(complnd), & - is_local%wrap%FBImp(:,complnd), fldListTo(complnd), & - document=first_call, string='(merge_to_lnd)', mastertask=mastertask, rc=rc) + is_local%wrap%FBExp(complnd), & + is_local%wrap%FBFrac(complnd), & + is_local%wrap%FBImp(:,complnd), & + fldListTo(complnd), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(complnd), string=trim(subname)//' FBexp(complnd) ', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(complnd), & + string=trim(subname)//' FBexp(complnd) ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if !--------------------------------------- !--- custom calculations !--------------------------------------- !--------------------------------------- - !--- update local scalar data + !--- update scalar data !--------------------------------------- - !is_local%wrap%scalar_data(1) = + ! send nextsw_cday to land - first obtain it from atm import + call shr_nuopc_methods_State_GetScalar(& + scalar_value=nextsw_cday, scalar_id=flds_scalar_index_nextsw_cday, & + state=is_local%wrap%NstateImp(compatm), flds_scalar_name=flds_scalar_name, & + flds_scalar_num=flds_scalar_num, rc=rc) + if (shr_nuopc_methods_chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_State_SetScalar(& + scalar_value=nextsw_cday, scalar_id=flds_scalar_index_nextsw_cday, & + state=is_local%wrap%NstateExp(complnd), flds_scalar_name=flds_scalar_name, & + flds_scalar_num=flds_scalar_num, rc=rc) + if (shr_nuopc_methods_chkerr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- !--- clean up !--------------------------------------- - first_call = .false. end if - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + end if call t_stopf('MED:'//subname) end subroutine med_phases_prep_lnd diff --git a/src/drivers/nuopc/mediator/med_phases_prep_ocn_mod.F90 b/src/drivers/nuopc/mediator/med_phases_prep_ocn_mod.F90 index d1e9d3d724eb..cae6dc9aa951 100644 --- a/src/drivers/nuopc/mediator/med_phases_prep_ocn_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_prep_ocn_mod.F90 @@ -1,13 +1,13 @@ module med_phases_prep_ocn_mod + !----------------------------------------------------------------------------- + ! Mediator phases for preparing ocn export from mediator + !----------------------------------------------------------------------------- + use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag use shr_nuopc_utils_mod , only : shr_nuopc_memcheck use med_internalstate_mod , only : mastertask - !----------------------------------------------------------------------------- - ! Carry out fast accumulation for the ocean - !----------------------------------------------------------------------------- - implicit none private @@ -86,6 +86,7 @@ subroutine med_phases_prep_ocn_map(gcomp, rc) is_local%wrap%FBImp(n1,n1), & is_local%wrap%FBImp(n1,compocn), & is_local%wrap%FBFrac(n1), & + is_local%wrap%FBFrac(compocn), & is_local%wrap%FBNormOne(n1,compocn,:), & is_local%wrap%RH(n1,compocn,:), & string=trim(compname(n1))//'2'//trim(compname(compocn)), rc=rc) @@ -113,7 +114,7 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) use shr_nuopc_methods_mod , only : FB_GetFldPtr => shr_nuopc_methods_FB_GetFldPtr use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getNumFlds - use med_constants_mod , only : R8 + use med_constants_mod , only : R8, CS use med_internalstate_mod , only : InternalState, mastertask, logunit use med_merge_mod , only : med_merge_auto, med_merge_field use esmFlds , only : fldListTo @@ -137,6 +138,7 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) real(R8), pointer :: Faxa_swvdf(:), Faxa_swndf(:) real(R8), pointer :: Faxa_swvdr(:), Faxa_swndr(:) real(R8), pointer :: Foxx_swnet(:) + real(R8), pointer :: Foxx_swnet_afracr(:) real(R8), pointer :: Foxx_swnet_vdr(:), Foxx_swnet_vdf(:) real(R8), pointer :: Foxx_swnet_idr(:), Foxx_swnet_idf(:) real(R8), pointer :: Fioi_swpen_vdr(:), Fioi_swpen_vdf(:) @@ -146,18 +148,21 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) real(R8), pointer :: Foxx_lwnet(:) real(R8), pointer :: Faox_lwup(:) real(R8), pointer :: Faxa_lwdn(:) + real(R8), pointer :: dataptr_i(:), dataptr_o(:) real(R8) :: ifrac_scaled, ofrac_scaled real(R8) :: ifracr_scaled, ofracr_scaled real(R8) :: frac_sum real(R8) :: albvis_dir, albvis_dif real(R8) :: albnir_dir, albnir_dif real(R8) :: fswabsv, fswabsi - real(R8) :: flux_epbalfact logical :: export_swnet_by_bands logical :: import_swpen_by_bands - logical :: first_call = .true. + logical :: export_swnet_afracr + logical :: first_precip_fact_call = .true. + real(R8) :: precip_fact integer :: lsize integer :: dbrc + character(CS) :: cvalue ! NEMS-orig real(R8), pointer :: ocnwgt1(:) real(R8), pointer :: icewgt1(:) @@ -193,7 +198,7 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) call shr_nuopc_methods_FB_getNumFlds(is_local%wrap%FBExp(compocn), trim(subname)//"FBexp(compocn)", ncnt, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (ncnt >= 0) then + if (ncnt > 0) then !--------------------------------------- !--- auto merges to ocn @@ -203,14 +208,12 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) call med_merge_auto(trim(compname(compocn)), & is_local%wrap%FBExp(compocn), is_local%wrap%FBFrac(compocn), & is_local%wrap%FBImp(:,compocn), fldListTo(compocn), & - FBMed1=is_local%wrap%FBMed_aoflux_o, & - document=first_call, string='(merge_to_ocn)', mastertask=mastertask, rc=rc) + FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'nems_frac') then call med_merge_auto(trim(compname(compocn)), & is_local%wrap%FBExp(compocn), is_local%wrap%FBFrac(compocn), & - is_local%wrap%FBImp(:,compocn), fldListTo(compocn), & - document=first_call, string='(merge_to_ocn)', mastertask=mastertask, rc=rc) + is_local%wrap%FBImp(:,compocn), fldListTo(compocn), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -276,7 +279,7 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) end if end if - ! Output to ocean + ! Output to ocean swnet if (fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet', Foxx_swnet, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -284,6 +287,8 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) lsize = size(Faxa_swvdr) allocate(Foxx_swnet(lsize)) end if + + ! Output to ocean swnet by radiation bands if (fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc)) then export_swnet_by_bands = .true. call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', Foxx_swnet_vdr, rc=rc) @@ -298,6 +303,15 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) export_swnet_by_bands = .false. end if + ! Swnet without swpen from sea-ice + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr',rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr', Foxx_swnet_afracr, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + export_swnet_afracr = .true. + else + export_swnet_afracr = .false. + end if + do n = 1,lsize ! Determine ocean albedos @@ -318,6 +332,10 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) fswabsi = Faxa_swndr(n) * (1.0_R8 - albnir_dir) + Faxa_swndf(n) * (1.0_R8 - albnir_dif) Foxx_swnet(n) = fswabsv + fswabsi + if (export_swnet_afracr) then + Foxx_swnet_afracr(n) = fswabsv + fswabsi + end if + ! Add swpen from sea ice if sea ice is present if (is_local%wrap%comp_present(compice)) then if (trim(coupling_mode) == 'cesm') then @@ -360,35 +378,61 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) Foxx_swnet_idf(n) = c4 * Foxx_swnet(n) end if end if - ! TODO (mvertens, 2018-12-16): fill in the following - ! if (i2o_per_cat) then - ! Sf_ofrac(n) = ofrac(n) - ! Sf_ofracr(n) = ofracr(n) - ! Foxx_swnet_ofracr(n) = (fswabsv + fswabsi) * ofracr_scaled - ! end if end if ! if sea-ice is present end do + ! Output to ocean per ice thickness fraction and sw penetrating into ocean + if ( fldchk(is_local%wrap%FBImp(compice,compice), 'Si_ifrac_n', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Si_ifrac_n', rc=rc)) then + + call FB_GetFldPtr(is_local%wrap%FBImp(compice,compice), 'Si_ifrac_n', dataptr_i, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Si_ifrac_n', dataptr_o, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + dataptr_o(:) = dataptr_i(:) + end if + + if ( fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_ifrac_n', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Fioi_swpen_ifrac_n', rc=rc)) then + + call FB_GetFldPtr(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_ifrac_n', dataptr_i, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Fioi_swpen_ifrac_n', dataptr_o, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + dataptr_o(:) = dataptr_i(:) + end if + + if ( fldchk(is_local%wrap%FBExp(compocn), 'Sf_afrac', rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afrac', dataptr_o, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + dataptr_o(:) = ofrac(:) + end if + + if ( fldchk(is_local%wrap%FBExp(compocn), 'Sf_afracr', rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afracr', dataptr_o, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + dataptr_o(:) = ofracr(:) + end if + !------------- - ! custom calculation for cesm coupling + ! application of precipitation factor from ocean !------------- - if (trim(coupling_mode) == 'cesm') then - - ! scale precipitation and runoff by epbalfact - ! TODO (mvertens, 2018-12-16): the calculation needs to be set - ! at run time based on receiving it from the ocean - flux_epbalfact = 1.0_r8 + precip_fact = 1.0_R8 + if (precip_fact /= 1.0_R8) then + if (first_precip_fact_call .and. mastertask) then + write(logunit,'(a)')'(merge_to_ocn): Scaling rain, snow, liquid and ice runoff by precip_fact ' + first_precip_fact_call = .false. + end if + write(cvalue,*) precip_fact + call ESMF_LogWrite(trim(subname)//" precip_fact is "//trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) - allocate(fldnames(5)) - fldnames = (/'Foxx_rain',' Foxx_snow', 'Foxx_prec', 'Foxx_rofl', 'Foxx_rofi'/) + allocate(fldnames(4)) + fldnames = (/'Faxa_rain',' Faxa_snow', 'Foxx_rofl', 'Foxx_rofi'/) do n = 1,size(fldnames) if (fldchk(is_local%wrap%FBExp(compocn), trim(fldnames(n)), rc=rc)) then call FB_GetFldPtr(is_local%wrap%FBExp(compocn), trim(fldnames(n)) , dataptr, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - dataptr(:) = dataptr(:) * flux_epbalfact - if (first_call .and. mastertask) then - write(logunit,'(a)')'(merge_to_ocn): Scaling '//trim(fldnames(n))//' by flux_epbalfact ' - end if + dataptr(:) = dataptr(:) * precip_fact end if end do deallocate(fldnames) @@ -507,8 +551,11 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) !--- diagnose output !--------------------------------------- - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compocn), string=trim(subname)//' FBexp(compocn) ', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compocn), & + string=trim(subname)//' FBexp(compocn) ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if ! TODO (mvertens, 2018-12-16): document above custom calculation @@ -516,7 +563,6 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) !--- clean up !--------------------------------------- - first_call = .false. endif if (dbug_flag > 20) then @@ -589,9 +635,11 @@ subroutine med_phases_prep_ocn_accum_fast(gcomp, rc) is_local%wrap%FBExpAccumCnt(compocn) = is_local%wrap%FBExpAccumCnt(compocn) + 1 - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExpAccum(compocn), & - string=trim(subname)//' FBExpAccum accumulation ', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExpAccum(compocn), & + string=trim(subname)//' FBExpAccum accumulation ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if !--------------------------------------- !--- clean up @@ -665,17 +713,21 @@ subroutine med_phases_prep_ocn_accum_avg(gcomp, rc) !--- average ocn accumulator !--------------------------------------- - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExpAccum(compocn), & - string=trim(subname)//' FBExpAccum(compocn) before avg ', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExpAccum(compocn), & + string=trim(subname)//' FBExpAccum(compocn) before avg ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if call shr_nuopc_methods_FB_average(is_local%wrap%FBExpAccum(compocn), & is_local%wrap%FBExpAccumCnt(compocn), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compocn), & - string=trim(subname)//' FBExpAccum(compocn) after avg ', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compocn), & + string=trim(subname)//' FBExpAccum(compocn) after avg ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if !--------------------------------------- !--- copy to FBExp(compocn) diff --git a/src/drivers/nuopc/mediator/med_phases_prep_rof_mod.F90 b/src/drivers/nuopc/mediator/med_phases_prep_rof_mod.F90 index 78e1bbe24b34..aeb9ca62000d 100644 --- a/src/drivers/nuopc/mediator/med_phases_prep_rof_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_prep_rof_mod.F90 @@ -10,10 +10,9 @@ module med_phases_prep_rof_mod ! this will be done in med_phases_prep_rof_avg !----------------------------------------------------------------------------- - use ESMF , only : ESMF_FieldBundle, ESMF_MAXSTR + use ESMF , only : ESMF_FieldBundle use esmFlds , only : ncomps, complnd, comprof, compname, mapconsf use med_constants_mod , only : R8, CS - use med_constants_mod , only : czero => med_constants_czero use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_chkerr use perf_mod , only : t_startf, t_stopf @@ -45,9 +44,12 @@ module med_phases_prep_rof_mod subroutine med_phases_prep_rof_accum_fast(gcomp, rc) + !------------------------------------ ! Carry out fast accumulation for the river (rof) component - ! Accumulation and averaging is done on the land input to the river component on the land grid + ! Accumulation and averaging is done on the land input on the land grid for the fields that will + ! will be sent to the river component ! Mapping from the land to the rof grid is then done with the time averaged fields + !------------------------------------ use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS @@ -59,6 +61,7 @@ subroutine med_phases_prep_rof_accum_fast(gcomp, rc) ! input/output variables type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc ! local variables @@ -89,31 +92,34 @@ subroutine med_phases_prep_rof_accum_fast(gcomp, rc) if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(complnd,complnd))) then ncnt = 0 + call ESMF_LogWrite(trim(subname)//": FBImp(complnd,complnd) is not created", & + ESMF_LOGMSG_INFO, rc=dbrc) else ! The scalar field has been removed from all mediator field bundles - so check if the fieldCount is ! 0 and not 1 here call ESMF_FieldBundleGet(is_local%wrap%FBImp(complnd,complnd), fieldCount=ncnt, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": only scalar data is present in FBimp(complnd), returning", & + ESMF_LOGMSG_INFO) end if - if (ncnt == 0) then - call ESMF_LogWrite(trim(subname)//": only scalar data is present in FBimp(complnd), returning", & - ESMF_LOGMSG_INFO, rc=dbrc) - else + !--------------------------------------- + !-- Accumulate lnd input on lnd grid to send to rof + !--------------------------------------- - !--------------------------------------- - ! Accumulate lnd input on lnd grid to send to rof - !--------------------------------------- - call shr_nuopc_methods_FB_accum(is_local%wrap%FBImpAccum(complnd,complnd), & + if (ncnt > 0) then + call shr_nuopc_methods_FB_accum(& + is_local%wrap%FBImpAccum(complnd,complnd), & is_local%wrap%FBImp(complnd,complnd), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return is_local%wrap%FBImpAccumCnt(complnd) = is_local%wrap%FBImpAccumCnt(complnd) + 1 - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBImpAccum(complnd,complnd), & - string=trim(subname)//' FBImpAccum(complnd,complnd) ', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBImpAccum(complnd,complnd), & + string=trim(subname)//' FBImpAccum(complnd,complnd) ', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if end if if (dbug_flag > 20) then @@ -127,7 +133,9 @@ end subroutine med_phases_prep_rof_accum_fast subroutine med_phases_prep_rof_avg(gcomp, rc) + !------------------------------------ ! Prepare the ROF export Fields from the mediator + !------------------------------------ use NUOPC , only : NUOPC_IsConnected use ESMF , only : ESMF_GridComp, ESMF_GridCompGet @@ -141,6 +149,7 @@ subroutine med_phases_prep_rof_avg(gcomp, rc) use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_FB_Regrid_Norm use med_internalstate_mod , only : InternalState, mastertask + use med_constants_mod , only : czero => med_constants_czero ! input/output variables type(ESMF_GridComp) :: gcomp @@ -152,7 +161,6 @@ subroutine med_phases_prep_rof_avg(gcomp, rc) integer :: dbrc logical :: connected real(r8), pointer :: dataptr(:) - logical , save :: first_call = .true. character(len=*),parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof_avg)' !--------------------------------------- @@ -194,9 +202,11 @@ subroutine med_phases_prep_rof_avg(gcomp, rc) is_local%wrap%FBImpAccumCnt(complnd), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBImpAccum(complnd,complnd), & - string=trim(subname)//' FBImpAccum(complnd,complnd) after avg ', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBImpAccum(complnd,complnd), & + string=trim(subname)//' FBImpAccum(complnd,complnd) after avg ', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if !--------------------------------------- !--- map to create FBImpAccum(complnd,comprof) @@ -212,14 +222,17 @@ subroutine med_phases_prep_rof_avg(gcomp, rc) is_local%wrap%FBImpAccum(complnd,complnd), & is_local%wrap%FBImpAccum(complnd,comprof), & is_local%wrap%FBFrac(complnd), & + is_local%wrap%FBFrac(comprof), & is_local%wrap%FBNormOne(complnd,comprof,:), & is_local%wrap%RH(complnd,comprof,:), & string=trim(compname(complnd))//'2'//trim(compname(comprof)), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBImpAccum(complnd,comprof), & - string=trim(subname)//' FBImpAccum(complnd,comprof) after avg ', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBImpAccum(complnd,comprof), & + string=trim(subname)//' FBImpAccum(complnd,comprof) after avg ', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if ! Reset the irrig_flux_field with the map_lnd2rof_irrig calculation below if appropriate if ( NUOPC_IsConnected(is_local%wrap%NStateImp(complnd), fieldname=trim(irrig_flux_field))) then @@ -238,21 +251,24 @@ subroutine med_phases_prep_rof_avg(gcomp, rc) !--- auto merges to create FBExp(comprof) !--------------------------------------- - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBFrac(comprof), & - string=trim(subname)//' FBFrac(comprof) before merge ', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBFrac(comprof), & + string=trim(subname)//' FBFrac(comprof) before merge ', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if call med_merge_auto(trim(compname(comprof)), & is_local%wrap%FBExp(comprof), & is_local%wrap%FBFrac(comprof), & is_local%wrap%FBImpAccum(:,comprof), & - fldListTo(comprof), & - document=first_call, string='(merge_to_rof)', mastertask=mastertask, rc=rc) + fldListTo(comprof), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(comprof), & - string=trim(subname)//' FBexp(comprof) ', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(comprof), & + string=trim(subname)//' FBexp(comprof) ', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if !--------------------------------------- !--- zero accumulator @@ -271,7 +287,6 @@ subroutine med_phases_prep_rof_avg(gcomp, rc) !--- clean up !--------------------------------------- - first_call = .false. endif if (dbug_flag > 20) then @@ -315,7 +330,6 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_reset use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_clean use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FieldRegrid - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose use shr_nuopc_scalars_mod , only : flds_scalar_name use med_internalstate_mod , only : InternalState, mastertask use med_map_mod , only : med_map_FB_Regrid_norm @@ -472,9 +486,10 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) ! convert to a total irrigation flux on the ROF grid ! ------------------------------------------------------------------------ - call med_map_FB_Regrid_Norm((/trim(irrig_normalized_field), trim(irrig_volr0_field)/), & + call med_map_FB_Regrid_Norm(& + (/trim(irrig_normalized_field), trim(irrig_volr0_field)/), & FBlndIrrig, FBrofIrrig, & - is_local%wrap%FBFrac(complnd), 'lfrin', & + is_local%wrap%FBFrac(complnd), 'lfrac', & is_local%wrap%RH(complnd, comprof, mapconsf), & string='mapping normalized irrig from lnd to to rof', rc=rc) diff --git a/src/drivers/nuopc/mediator/med_phases_prep_wav_mod.F90 b/src/drivers/nuopc/mediator/med_phases_prep_wav_mod.F90 index 2213b76d0345..a94a264db78f 100644 --- a/src/drivers/nuopc/mediator/med_phases_prep_wav_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_prep_wav_mod.F90 @@ -1,152 +1,137 @@ module med_phases_prep_wav_mod !----------------------------------------------------------------------------- - ! Mediator Phases + ! Mediator phases for preparing wav export from mediator !----------------------------------------------------------------------------- implicit none private - character(*) , parameter :: u_FILE_u = __FILE__ - public :: med_phases_prep_wav + character(*), parameter :: u_FILE_u = & + __FILE__ + !----------------------------------------------------------------------------- - contains +contains !----------------------------------------------------------------------------- - subroutine med_phases_prep_wav(gcomp, rc) - use ESMF, only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF, only : ESMF_GridComp, ESMF_Clock, ESMF_Time - use ESMF, only : ESMF_GridCompGet, ESMF_FieldBundleGet, ESMF_ClockGet, ESMF_TimeGet - use ESMF, only : ESMF_ClockPrint - use med_constants_mod, only : CS - use esmFlds , only : compwav, ncomps, compname - use esmFlds , only : fldListFr, fldListTo - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose - use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag - use med_merge_mod , only : med_merge_auto - use med_map_mod , only : med_map_FB_Regrid_Norm - use med_internalstate_mod , only : InternalState, mastertask - use perf_mod , only : t_startf, t_stopf - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! Prepares the WAV import Fields. - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_Time) :: time - character(len=CS) :: timestr - type(InternalState) :: is_local - integer :: i,j,n,n1,ncnt - logical,save :: first_call = .true. - integer :: dbrc - character(len=*),parameter :: subname='(med_phases_prep_wav)' - !--------------------------------------- - call t_startf('MED:'//subname) - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - rc = ESMF_SUCCESS - - !--------------------------------------- - ! --- Get the internal state - !--------------------------------------- - - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - !--------------------------------------- - !--- Count the number of fields outside of scalar data, if zero, then return - !--------------------------------------- - - ! Note - the scalar field has been removed from all mediator field bundles - so this is why we check if the - ! fieldCount is 0 and not 1 here - - call ESMF_FieldBundleGet(is_local%wrap%FBExp(compwav), fieldCount=ncnt, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - if (ncnt == 0) then - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": only scalar data is present in FBexp(compwav), returning", & - ESMF_LOGMSG_INFO, rc=dbrc) - endif - else - - !--------------------------------------- - !--- Get the current time from the clock - !--------------------------------------- - - call ESMF_GridCompGet(gcomp, clock=clock) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_ClockGet(clock,currtime=time,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_TimeGet(time,timestring=timestr) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": time = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) - endif - - if (mastertask) then - call ESMF_ClockPrint(clock, options="currTime", preString="-------->"//trim(subname)//" mediating for: ", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - !--------------------------------------- - !--- map to create FBimp(:,compwav) - !--------------------------------------- - - do n1 = 1,ncomps - if (is_local%wrap%med_coupling_active(n1,compwav)) then - call med_map_FB_Regrid_Norm( & - fldListFr(n1)%flds, n1, compwav, & - is_local%wrap%FBImp(n1,n1), & - is_local%wrap%FBImp(n1,compwav), & - is_local%wrap%FBFrac(n1), & - is_local%wrap%FBNormOne(n1,compwav,:), & - is_local%wrap%RH(n1,compwav,:), & - string=trim(compname(n1))//'2'//trim(compname(compwav)), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif - enddo - - !--------------------------------------- - !--- auto merges - !--------------------------------------- - - call med_merge_auto(trim(compname(compwav)), & - is_local%wrap%FBExp(compwav), is_local%wrap%FBFrac(compwav), & - is_local%wrap%FBImp(:,compwav), fldListTo(compwav), & - document=first_call, string='(merge_to_wav)', mastertask=mastertask, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - if (dbug_flag > 1) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compwav), string=trim(subname)//' FBexp(compwav) ', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif - - !--------------------------------------- - !--- custom calculations - !--------------------------------------- - - !--------------------------------------- - !--- update local scalar data - !--------------------------------------- - - !is_local%wrap%scalar_data(1) = - - !--------------------------------------- - !--- clean up - !--------------------------------------- - - first_call = .false. - endif - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - call t_stopf('MED:'//subname) - - end subroutine med_phases_prep_wav + subroutine med_phases_prep_wav(gcomp, rc) + + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time + use ESMF , only : ESMF_GridCompGet, ESMF_FieldBundleGet, ESMF_ClockGet, ESMF_TimeGet + use ESMF , only : ESMF_ClockPrint + use med_constants_mod , only : CS + use esmFlds , only : compwav, ncomps, compname + use esmFlds , only : fldListFr, fldListTo + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getNumFlds + use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag + use med_merge_mod , only : med_merge_auto + use med_map_mod , only : med_map_FB_Regrid_Norm + use med_internalstate_mod , only : InternalState, mastertask + use perf_mod , only : t_startf, t_stopf + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + integer :: i,j,n,n1,ncnt + integer :: dbrc + character(len=*),parameter :: subname='(med_phases_prep_wav)' + !--------------------------------------- + + call t_startf('MED:'//subname) + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + end if + rc = ESMF_SUCCESS + + !--------------------------------------- + ! --- Get the internal state + !--------------------------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + ! --- Count the number of fields outside of scalar data, if zero, then return + !--------------------------------------- + + ! Note - the scalar field has been removed from all mediator field bundles - so this is why we check if the + ! fieldCount is 0 and not 1 here + + call shr_nuopc_methods_FB_getNumFlds(is_local%wrap%FBExp(compwav), trim(subname)//"FBexp(compwav)", ncnt, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (ncnt > 0) then + + !--------------------------------------- + !--- map to create FBimp(:,compwav) + !--------------------------------------- + + do n1 = 1,ncomps + if (is_local%wrap%med_coupling_active(n1,compwav)) then + call med_map_FB_Regrid_Norm( & + fldListFr(n1)%flds, n1, compwav, & + is_local%wrap%FBImp(n1,n1), & + is_local%wrap%FBImp(n1,compwav), & + is_local%wrap%FBFrac(n1), & + is_local%wrap%FBFrac(compwav), & + is_local%wrap%FBNormOne(n1,compwav,:), & + is_local%wrap%RH(n1,compwav,:), & + string=trim(compname(n1))//'2'//trim(compname(compwav)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + enddo + + !--------------------------------------- + !--- auto merges to create FBExp(compwav) + !--------------------------------------- + + call med_merge_auto(trim(compname(compwav)), & + is_local%wrap%FBExp(compwav), & + is_local%wrap%FBFrac(compwav), & + is_local%wrap%FBImp(:,compwav), & + fldListTo(compwav), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + !--- diagnose output + !--------------------------------------- + + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compwav), & + string=trim(subname)//' FBexp(compwav) ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + !--------------------------------------- + !--- custom calculations + !--------------------------------------- + + !--------------------------------------- + !--- update local scalar data + !--------------------------------------- + + !is_local%wrap%scalar_data(1) = + + !--------------------------------------- + !--- clean up + !--------------------------------------- + + endif + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + end if + call t_stopf('MED:'//subname) + + end subroutine med_phases_prep_wav end module med_phases_prep_wav_mod diff --git a/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 b/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 index fab1b2e34fc8..b113c1e7f3bf 100644 --- a/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 @@ -38,7 +38,6 @@ subroutine med_phases_restart_write(gcomp, rc) use esmFlds , only : ncomps, compname, compocn use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use med_internalstate_mod , only : InternalState - use med_infodata_mod , only : med_infodata, med_infodata_GetData use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef use med_io_mod , only : med_io_close, med_io_date2yyyymmdd @@ -268,9 +267,11 @@ subroutine med_phases_restart_write(gcomp, rc) do n = 1,ncomps if (is_local%wrap%comp_present(n)) then + nx = is_local%wrap%nx(n) + ny = is_local%wrap%ny(n) + ! Write import field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - call med_infodata_GetData(med_infodata, ncomp=n, nx=nx, ny=ny) !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) call med_io_write(restart_file, iam, is_local%wrap%FBimp(n,n), & @@ -280,7 +281,6 @@ subroutine med_phases_restart_write(gcomp, rc) ! Write fraction field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then - call med_infodata_GetData(med_infodata, ncomp=n, nx=nx, ny=ny) !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) call med_io_write(restart_file, iam, is_local%wrap%FBfrac(n), & @@ -291,7 +291,6 @@ subroutine med_phases_restart_write(gcomp, rc) ! Write export accumulators if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccum(n),rc=rc)) then ! TODO: only write this out if actually have done accumulation - call med_infodata_GetData(med_infodata, ncomp=n, nx=nx, ny=ny) !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) call med_io_write(restart_file, iam, is_local%wrap%FBExpAccum(n), & @@ -303,7 +302,8 @@ subroutine med_phases_restart_write(gcomp, rc) !Write ocn albedo field bundle (CESM only) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then - call med_infodata_GetData(med_infodata, ncomp=compocn, nx=nx, ny=ny) + nx = is_local%wrap%nx(compocn) + ny = is_local%wrap%ny(compocn) call med_io_write(restart_file, iam, is_local%wrap%FBMed_ocnalb_o, & nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='MedOcnAlb_o', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/drivers/nuopc/shr/med_constants_mod.F90 b/src/drivers/nuopc/shr/med_constants_mod.F90 index c5e1f0454ebc..b37a65f21c64 100644 --- a/src/drivers/nuopc/shr/med_constants_mod.F90 +++ b/src/drivers/nuopc/shr/med_constants_mod.F90 @@ -36,6 +36,6 @@ module med_constants_mod integer, parameter :: med_constants_SecPerDay = 86400 ! Seconds per day !----------------------------------------------------------------------------- - integer :: med_constants_dbug_flag = 0 + integer :: med_constants_dbug_flag = 5 end module med_constants_mod diff --git a/src/drivers/nuopc/shr/shr_nuopc_methods_mod.F90 b/src/drivers/nuopc/shr/shr_nuopc_methods_mod.F90 index 6ab11a940795..7c4dc6bed8a8 100644 --- a/src/drivers/nuopc/shr/shr_nuopc_methods_mod.F90 +++ b/src/drivers/nuopc/shr/shr_nuopc_methods_mod.F90 @@ -51,6 +51,7 @@ module shr_nuopc_methods_mod public shr_nuopc_methods_FB_accum public shr_nuopc_methods_FB_average public shr_nuopc_methods_FB_init + public shr_nuopc_methods_FB_init_pointer public shr_nuopc_methods_FB_reset public shr_nuopc_methods_FB_clean public shr_nuopc_methods_FB_diagnose @@ -58,9 +59,10 @@ module shr_nuopc_methods_mod public shr_nuopc_methods_FB_GetFldPtr public shr_nuopc_methods_FB_getNameN public shr_nuopc_methods_FB_getFieldN - public shr_nuopc_methods_FB_Field_diagnose public shr_nuopc_methods_FB_FieldRegrid public shr_nuopc_methods_FB_getNumflds + public shr_nuopc_methods_FB_Field_diagnose + public shr_nuopc_methods_Field_diagnose public shr_nuopc_methods_State_reset public shr_nuopc_methods_State_diagnose public shr_nuopc_methods_State_GeomPrint @@ -104,11 +106,12 @@ module shr_nuopc_methods_mod private shr_nuopc_methods_State_SetFldPtr private shr_nuopc_methods_Array_diagnose - !----------------------------------------------------------------------------- - contains - !----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- +contains +!----------------------------------------------------------------------------- subroutine shr_nuopc_methods_FB_RWFields(mode,fname,FB,flag,rc) + ! ---------------------------------------------- ! Read or Write Field Bundles ! ---------------------------------------------- @@ -126,18 +129,17 @@ subroutine shr_nuopc_methods_FB_RWFields(mode,fname,FB,flag,rc) character(len=ESMF_MAXSTR) :: name integer :: fieldcount, n logical :: fexists - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_FB_RWFields)' ! ---------------------------------------------- rc = ESMF_SUCCESS if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//trim(fname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//trim(fname)//": called", ESMF_LOGMSG_INFO) endif if (mode == 'write') then if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": write "//trim(fname), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": write "//trim(fname), ESMF_LOGMSG_INFO) end if call ESMF_FieldBundleWrite(FB, fname, & singleFile=.true., status=ESMF_FILESTATUS_REPLACE, iofmt=ESMF_IOFMT_NETCDF, rc=rc) @@ -148,7 +150,7 @@ subroutine shr_nuopc_methods_FB_RWFields(mode,fname,FB,flag,rc) inquire(file=fname,exist=fexists) if (fexists) then if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": read "//trim(fname), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": read "//trim(fname), ESMF_LOGMSG_INFO) end if !----------------------------------------------------------------------------------------------------- ! tcraig, ESMF_FieldBundleRead fails if a field is not on the field bundle, but we really want to just @@ -164,7 +166,8 @@ subroutine shr_nuopc_methods_FB_RWFields(mode,fname,FB,flag,rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRead (field, fname, iofmt=ESMF_IOFMT_NETCDF, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=u_FILE_u)) call ESMF_LogWrite(trim(subname)//' WARNING missing field '//trim(name),rc=dbrc) + line=__LINE__, file=u_FILE_u)) call ESMF_LogWrite(trim(subname)//& + ' WARNING missing field '//trim(name)) enddo call shr_nuopc_methods_FB_diagnose(FB, 'read '//trim(fname), rc) @@ -172,41 +175,188 @@ subroutine shr_nuopc_methods_FB_RWFields(mode,fname,FB,flag,rc) endif else - call ESMF_LogWrite(trim(subname)//": mode WARNING "//trim(fname)//" mode="//trim(mode), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": mode WARNING "//trim(fname)//" mode="//trim(mode), ESMF_LOGMSG_INFO) endif if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//trim(fname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//trim(fname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_RWFields !----------------------------------------------------------------------------- - subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, STgeom, FBflds, STflds, name, rc) + subroutine shr_nuopc_methods_FB_init_pointer(StateIn, FBout, flds_scalar_name, name, rc) - use ESMF , only : ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleCreate, ESMF_FieldBundleGet - use ESMF , only : ESMF_State, ESMF_Grid, ESMF_Mesh, ESMF_StaggerLoc, ESMF_MeshLoc - use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_FieldBundleAdd, ESMF_FieldCreate - use ESMF , only : ESMF_TYPEKIND_R8, ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID - use ESMF , only : ESMF_FIELDSTATUS_EMPTY - use med_constants_mod , only : spval_init => med_constants_spval_init + ! ---------------------------------------------- + ! Create FBout from StateIn mesh and pointer + ! ---------------------------------------------- + + use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleAdd, ESMF_FieldBundleCreate + use ESMF , only : ESMF_State, ESMF_StateGet, ESMF_Mesh, ESMF_MeshLoc + use ESMF , only : ESMF_AttributeGet, ESMF_INDEX_DELOCAL + use med_constants_mod , only : R8 + + ! input/output variables + type(ESMF_State) , intent(in) :: StateIn ! input state + type(ESMF_FieldBundle), intent(inout) :: FBout ! output field bundle + character(len=*) , intent(in) :: flds_scalar_name ! name of scalar fields + character(len=*) , intent(in) :: name + integer , intent(out) :: rc + + ! local variables + logical :: isPresent + integer :: n,n1 + type(ESMF_Field) :: lfield + type(ESMF_Field) :: newfield + type(ESMF_MeshLoc) :: meshloc + type(ESMF_Mesh) :: lmesh + integer :: lrank + integer :: fieldCount + integer :: ungriddedCount + integer :: gridToFieldMapCount + integer :: ungriddedLBound(1) + integer :: ungriddedUBound(1) + integer :: gridToFieldMap(1) + real(R8), pointer :: dataptr1d(:) + real(R8), pointer :: dataptr2d(:,:) + character(ESMF_MAXSTR), allocatable :: lfieldNameList(:) + character(len=*), parameter :: subname='(shr_nuopc_methods_FB_init_pointer)' + ! ---------------------------------------------- + + ! Create empty FBout + FBout = ESMF_FieldBundleCreate(name=trim(name), rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Get fields from StateIn + call ESMF_StateGet(StateIn, itemCount=fieldCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldNameList(fieldCount)) + call ESMF_StateGet(StateIn, itemNameList=lfieldNameList, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Remove scalar field and blank fields from field bundle + do n = 1, fieldCount + if (trim(lfieldnamelist(n)) == trim(flds_scalar_name) .or. trim(lfieldnamelist(n)) == '') then + do n1 = n, fieldCount-1 + lfieldnamelist(n1) = lfieldnamelist(n1+1) + enddo + fieldCount = fieldCount - 1 + endif + enddo ! n + + ! Only create the fieldbundle if the number of non-scalar fields is > 0 + if (fieldCount > 0) then + + ! Get mesh from first non-scalar field in StateIn (assumes all the fields have the same mesh) + call ESMF_StateGet(StateIn, itemName=lfieldNameList(1), field=lfield, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, mesh=lmesh, meshloc=meshloc, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Loop over fields in StateIn skipping the field with just scalar data + do n = 1, fieldCount + ! get field from StateIn + call ESMF_StateGet(StateIn, itemName=lfieldNameList(n), field=lfield, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! determine rank of field + call ESMF_FieldGet(lfield, rank=lrank, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 2) then + + ! determine ungridded lower and upper bounds for lfield + call ESMF_AttributeGet(lfield, name="UngriddedLBound", convention="NUOPC", & + purpose="Instance", itemCount=ungriddedCount, isPresent=isPresent, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ungriddedCount /= 1) then + call ESMF_LogWrite(trim(subname)//": ERROR ungriddedCount for "// & + trim(lfieldnamelist(n))//" must be 1 if rank is 2 ", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + end if + + ! set ungridded dimensions and GridToFieldMap for field + call ESMF_AttributeGet(lfield, name="UngriddedLBound", convention="NUOPC", & + purpose="Instance", valueList=ungriddedLBound, rc=rc) + call ESMF_AttributeGet(lfield, name="UngriddedUBound", convention="NUOPC", & + purpose="Instance", valueList=ungriddedUBound, rc=rc) + call ESMF_AttributeGet(lfield, name="GridToFieldMap", convention="NUOPC", & + purpose="Instance", valueList=gridToFieldMap, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! get 2d pointer for field + call ESMF_FieldGet(lfield, farrayptr=dataptr2d, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create new field with an ungridded dimension + newfield = ESMF_FieldCreate(lmesh, dataptr2d, ESMF_INDEX_DELOCAL, & + meshloc=meshloc, name=lfieldNameList(n), & + ungriddedLbound=ungriddedLbound, ungriddedUbound=ungriddedUbound, gridToFieldMap=gridtoFieldMap, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + else if (lrank == 1) then + + ! get 1d pointer for field + call ESMF_FieldGet(lfield, farrayptr=dataptr1d, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create new field without an ungridded dimension + newfield = ESMF_FieldCreate(lmesh, dataptr1d, ESMF_INDEX_DELOCAL, & + meshloc=meshloc, name=lfieldNameList(n), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + else + + call ESMF_LogWrite(trim(subname)//": ERROR only rank1 and rank2 are supported for rank of fields ", & + ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + + end if + + ! Add new field to FBout + call ESMF_FieldBundleAdd(FBout, (/newfield/), rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + end do ! end of loop over input state fields + end if ! end of fieldcount > 0 + + deallocate(lfieldNameList) + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": FBout from input State and field pointers", ESMF_LOGMSG_INFO, rc=rc) + end if + + end subroutine shr_nuopc_methods_FB_init_pointer + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, STgeom, FBflds, STflds, name, rc) ! ---------------------------------------------- ! Create FBout from fieldNameList, FBflds, STflds, FBgeom or STgeom in that order or priority - ! Pass in FBgeom OR STgeom, get grid/mesh from that object + ! Pass in FBgeom OR STgeom, get mesh from that object ! ---------------------------------------------- + use ESMF , only : ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleCreate, ESMF_FieldBundleGet + use ESMF , only : ESMF_State, ESMF_Mesh, ESMF_StaggerLoc, ESMF_MeshLoc + use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_FieldBundleAdd, ESMF_FieldCreate + use ESMF , only : ESMF_TYPEKIND_R8, ESMF_FIELDSTATUS_EMPTY, ESMF_AttributeGet + use med_constants_mod , only : spval_init => med_constants_spval_init + ! input/output variables - type(ESMF_FieldBundle), intent(inout) :: FBout - character(len=*) , intent(in) :: flds_scalar_name - character(len=*) , intent(in), optional :: fieldNameList(:) - type(ESMF_FieldBundle), intent(in), optional :: FBgeom - type(ESMF_State) , intent(in), optional :: STgeom - type(ESMF_FieldBundle), intent(in), optional :: FBflds - type(ESMF_State) , intent(in), optional :: STflds - character(len=*) , intent(in), optional :: name - integer , intent(out) :: rc + type(ESMF_FieldBundle), intent(inout) :: FBout ! output field bundle + character(len=*) , intent(in) :: flds_scalar_name ! name of scalar fields + character(len=*) , intent(in), optional :: fieldNameList(:) ! names of fields to use in output field bundle + type(ESMF_FieldBundle), intent(in), optional :: FBgeom ! input field bundle geometry to use + type(ESMF_State) , intent(in), optional :: STgeom ! input state geometry to use + type(ESMF_FieldBundle), intent(in), optional :: FBflds ! input field bundle fields + type(ESMF_State) , intent(in), optional :: STflds ! input state fields + character(len=*) , intent(in), optional :: name ! name to use for output field bundle + integer , intent(out) :: rc ! local variables integer :: i,j,n,n1 @@ -214,17 +364,21 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg logical :: found character(ESMF_MAXSTR) :: lname type(ESMF_Field) :: field,lfield - type(ESMF_Grid) :: lgrid type(ESMF_Mesh) :: lmesh type(ESMF_StaggerLoc) :: staggerloc type(ESMF_MeshLoc) :: meshloc - integer :: dbrc - character(ESMF_MAXSTR),allocatable :: lfieldNameList(:) - character(len=*),parameter :: subname='(shr_nuopc_methods_FB_init)' + integer :: ungriddedCount + integer, allocatable :: ungriddedLBound(:) + integer, allocatable :: ungriddedUBound(:) + integer :: gridToFieldMapCount + integer, allocatable :: gridToFieldMap(:) + logical :: isPresent + character(ESMF_MAXSTR), allocatable :: lfieldNameList(:) + character(len=*), parameter :: subname='(shr_nuopc_methods_FB_init)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -241,21 +395,21 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg if (present(fieldNameList) .and. present(FBflds) .and. present(STflds)) then call ESMF_LogWrite(trim(subname)//": ERROR only fieldNameList, FBflds, or STflds can be an argument", & - ESMF_LOGMSG_INFO, rc=rc) + ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return endif if (present(FBgeom) .and. present(STgeom)) then call ESMF_LogWrite(trim(subname)//": ERROR FBgeom and STgeom cannot both be arguments", & - ESMF_LOGMSG_INFO, rc=rc) + ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return endif if (.not.present(FBgeom) .and. .not.present(STgeom)) then call ESMF_LogWrite(trim(subname)//": ERROR FBgeom or STgeom must be an argument", & - ESMF_LOGMSG_INFO, rc=rc) + ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return endif @@ -267,7 +421,7 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg call ESMF_StateGet(STgeom, itemCount=fieldCountGeom, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return else - call ESMF_LogWrite(trim(subname)//": ERROR FBgeom or STgeom must be passed", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": ERROR FBgeom or STgeom must be passed", ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return endif @@ -321,7 +475,7 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg end if else call ESMF_LogWrite(trim(subname)//": ERROR fieldNameList, FBflds, STflds, FBgeom, or STgeom must be passed", & - ESMF_LOGMSG_INFO, rc=rc) + ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return endif @@ -341,27 +495,26 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg enddo ! n !--------------------------------- - ! create the grid (lgrid) or mesh(lmesh) - ! that will be used for FBout fields + ! create the mesh(lmesh) that will be used for FBout fields !--------------------------------- if (fieldcount > 0 .and. fieldcountgeom > 0) then - ! Look at only the first field in either the FBgeom and STgeom to get the grid + ! Look at only the first field in either the FBgeom and STgeom to get the mesh if (present(FBgeom)) then call shr_nuopc_methods_FB_getFieldN(FBgeom, 1, lfield, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" grid/mesh from FBgeom", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" mesh from FBgeom", ESMF_LOGMSG_INFO) end if elseif (present(STgeom)) then call shr_nuopc_methods_State_getFieldN(STgeom, 1, lfield, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" grid/mesh from STgeom", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" mesh from STgeom", ESMF_LOGMSG_INFO) end if else - call ESMF_LogWrite(trim(subname)//": ERROR FBgeom or STgeom must be passed", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": ERROR FBgeom or STgeom must be passed", ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return endif @@ -371,32 +524,17 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (status == ESMF_FIELDSTATUS_EMPTY) then call ESMF_LogWrite(trim(subname)//":"//trim(lname)//": ERROR field does not have a geom yet ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif - ! Determine if first field in either FBgeom or STgeom is on a grid or a mesh - call ESMF_FieldGet(lfield, geomtype=geomtype, rc=rc) + ! Assume field is on mesh + call ESMF_FieldGet(lfield, mesh=lmesh, meshloc=meshloc, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - - if (geomtype == ESMF_GEOMTYPE_GRID) then - call ESMF_FieldGet(lfield, grid=lgrid, staggerloc=staggerloc, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" use grid", ESMF_LOGMSG_INFO, rc=rc) - end if - elseif (geomtype == ESMF_GEOMTYPE_MESH) then - call ESMF_FieldGet(lfield, mesh=lmesh, meshloc=meshloc, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" use mesh", ESMF_LOGMSG_INFO, rc=rc) - end if - else ! geomtype - call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - endif ! geomtype + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" use mesh", ESMF_LOGMSG_INFO) + end if endif ! fieldcount > 0 @@ -409,32 +547,73 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg if (fieldcountgeom > 0) then - ! Now loop over all the fields in either FBgeom or STgeom - do n = 1, fieldCount + ! Now loop over all the fields in the field name list + do n = 1, fieldCount - ! Create the field on either lgrid or lmesh - if (geomtype == ESMF_GEOMTYPE_GRID) then - field = ESMF_FieldCreate(lgrid, ESMF_TYPEKIND_R8, staggerloc=staggerloc, name=lfieldNameList(n), rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - elseif (geomtype == ESMF_GEOMTYPE_MESH) then - field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - else ! geomtype - call ESMF_LogWrite(trim(subname)//": ERROR no grid/mesh for field ", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - endif + ! Note that input fields come from ONE of FBFlds, STflds, or fieldNamelist input argument + if (present(FBFlds) .or. present(STflds)) then - ! Add the created field bundle FBout - call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" adding field "//trim(lfieldNameList(n)), & - ESMF_LOGMSG_INFO, rc=dbrc) - endif + ! ungridded dimensions might be present in the input states or field bundles + if (present(FBflds)) then + call shr_nuopc_methods_FB_getFieldN(FBflds, n, lfield, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + elseif (present(STflds)) then + call shr_nuopc_methods_State_getFieldN(STflds, n, lfield, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + end if - enddo ! fieldCount + ! Determine ungridded lower and upper bounds for lfield + ungriddedCount=0 ! initialize in case it was not set + call ESMF_AttributeGet(lfield, name="UngriddedLBound", convention="NUOPC", & + purpose="Instance", itemCount=ungriddedCount, isPresent=isPresent, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! Create the field on a lmesh + if (ungriddedCount > 0) then + ! ungridded dimensions in field + allocate(ungriddedLBound(ungriddedCount), ungriddedUBound(ungriddedCount)) + call ESMF_AttributeGet(lfield, name="UngriddedLBound", convention="NUOPC", & + purpose="Instance", valueList=ungriddedLBound, rc=rc) + call ESMF_AttributeGet(lfield, name="UngriddedUBound", convention="NUOPC", & + purpose="Instance", valueList=ungriddedUBound, rc=rc) + + call ESMF_AttributeGet(lfield, name="GridToFieldMap", convention="NUOPC", & + purpose="Instance", itemCount=gridToFieldMapCount, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(gridToFieldMap(gridToFieldMapCount)) + call ESMF_AttributeGet(lfield, name="GridToFieldMap", convention="NUOPC", & + purpose="Instance", valueList=gridToFieldMap, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), & + ungriddedLbound=ungriddedLbound, ungriddedUbound=ungriddedUbound, & + gridToFieldMap=gridToFieldMap) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + deallocate( ungriddedLbound, ungriddedUbound, gridToFieldMap) + else + ! No ungridded dimensions in field + field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + else if (present(fieldNameList)) then + + ! Assume no ungridded dimensions if just the field name list is give + field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + end if + + ! Add the created field bundle FBout + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" adding field "//trim(lfieldNameList(n)), & + ESMF_LOGMSG_INFO) + end if + call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + enddo ! fieldCount endif ! fieldcountgeom deallocate(lfieldNameList) @@ -443,7 +622,7 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_init @@ -451,10 +630,14 @@ end subroutine shr_nuopc_methods_FB_init !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_FB_getNameN(FB, fieldnum, fieldname, rc) - use ESMF, only : ESMF_FieldBundle, ESMF_FieldBundleGet + ! ---------------------------------------------- - ! Get name of field number fieldnum in FB + ! Get name of field number fieldnum in input field bundle FB ! ---------------------------------------------- + + use ESMF, only : ESMF_FieldBundle, ESMF_FieldBundleGet + + ! input/output variables type(ESMF_FieldBundle), intent(in) :: FB integer , intent(in) :: fieldnum character(len=*) , intent(out) :: fieldname @@ -463,12 +646,11 @@ subroutine shr_nuopc_methods_FB_getNameN(FB, fieldnum, fieldname, rc) ! local variables integer :: fieldCount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_FB_getNameN)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -478,7 +660,7 @@ subroutine shr_nuopc_methods_FB_getNameN(FB, fieldnum, fieldname, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldnum > fieldCount) then - call ESMF_LogWrite(trim(subname)//": ERROR fieldnum > fieldCount ", ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": ERROR fieldnum > fieldCount ", ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return endif @@ -492,7 +674,7 @@ subroutine shr_nuopc_methods_FB_getNameN(FB, fieldnum, fieldname, rc) deallocate(lfieldnamelist) if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_getNameN @@ -500,11 +682,14 @@ end subroutine shr_nuopc_methods_FB_getNameN !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_FB_getFieldN(FB, fieldnum, field, rc) - use ESMF, only : ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleGet ! ---------------------------------------------- - ! Get field number fieldnum out of FB + ! Get field with number fieldnum in input field bundle FB ! ---------------------------------------------- + + use ESMF, only : ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleGet + + ! input/output variables type(ESMF_FieldBundle), intent(in) :: FB integer , intent(in) :: fieldnum type(ESMF_Field) , intent(inout) :: field @@ -512,12 +697,11 @@ subroutine shr_nuopc_methods_FB_getFieldN(FB, fieldnum, field, rc) ! local variables character(len=ESMF_MAXSTR) :: name - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_FB_getFieldN)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -528,7 +712,7 @@ subroutine shr_nuopc_methods_FB_getFieldN(FB, fieldnum, field, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_getFieldN @@ -536,22 +720,25 @@ end subroutine shr_nuopc_methods_FB_getFieldN !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_FB_getFieldByName(FB, fieldname, field, rc) - use ESMF, only : ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleGet + ! ---------------------------------------------- ! Get field associated with fieldname out of FB ! ---------------------------------------------- + + use ESMF, only : ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleGet + + ! input/output variables type(ESMF_FieldBundle), intent(in) :: FB character(len=*) , intent(in) :: fieldname type(ESMF_Field) , intent(inout) :: field integer , intent(out) :: rc ! local variables - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_FB_getFieldByName)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -559,7 +746,7 @@ subroutine shr_nuopc_methods_FB_getFieldByName(FB, fieldname, field, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_getFieldByName @@ -579,12 +766,11 @@ subroutine shr_nuopc_methods_State_getNameN(State, fieldnum, fieldname, rc) ! local variables integer :: fieldCount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_State_getNameN)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -594,7 +780,7 @@ subroutine shr_nuopc_methods_State_getNameN(State, fieldnum, fieldname, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldnum > fieldCount) then - call ESMF_LogWrite(trim(subname)//": ERROR fieldnum > fieldCount ", ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": ERROR fieldnum > fieldCount ", ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return endif @@ -608,7 +794,7 @@ subroutine shr_nuopc_methods_State_getNameN(State, fieldnum, fieldname, rc) deallocate(lfieldnamelist) if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_State_getNameN @@ -631,12 +817,11 @@ subroutine shr_nuopc_methods_State_getNumFields(State, fieldnum, rc) type(ESMF_Field), pointer :: fieldList(:) type(ESMF_StateItem_Flag), pointer :: itemTypeList(:) logical, parameter :: use_NUOPC_method = .true. - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_State_getNumFields)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -671,7 +856,7 @@ subroutine shr_nuopc_methods_State_getNumFields(State, fieldnum, rc) endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_State_getNumFields @@ -690,12 +875,11 @@ subroutine shr_nuopc_methods_State_getFieldN(State, fieldnum, field, rc) ! local variables character(len=ESMF_MAXSTR) :: name - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_State_getFieldN)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -704,9 +888,8 @@ subroutine shr_nuopc_methods_State_getFieldN(State, fieldnum, field, rc) call ESMF_StateGet(State, itemName=name, field=field, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_State_getFieldN @@ -725,12 +908,11 @@ subroutine shr_nuopc_methods_State_getFieldByName(State, fieldname, field, rc) integer , intent(out) :: rc ! local variables - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_State_getFieldByName)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -738,7 +920,7 @@ subroutine shr_nuopc_methods_State_getFieldByName(State, fieldname, field, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_State_getFieldByName @@ -761,11 +943,10 @@ subroutine shr_nuopc_methods_FB_clean(FB, rc) integer :: fieldCount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) type(ESMF_Field) :: field - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_FB_clean)' ! ---------------------------------------------- - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) @@ -784,7 +965,7 @@ subroutine shr_nuopc_methods_FB_clean(FB, rc) call ESMF_FieldBundleDestroy(FB, rc=rc, noGarbage=.true.) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(lfieldnamelist) - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine shr_nuopc_methods_FB_clean @@ -808,12 +989,11 @@ subroutine shr_nuopc_methods_FB_reset(FB, value, rc) integer :: fieldCount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) real(R8) :: lvalue - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_FB_reset)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -836,7 +1016,7 @@ subroutine shr_nuopc_methods_FB_reset(FB, value, rc) deallocate(lfieldnamelist) if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_reset @@ -862,12 +1042,12 @@ subroutine shr_nuopc_methods_FB_FieldRegrid(FBin,fldin,FBout,fldout,RH,rc,zerore type(ESMF_RouteHandle), intent(inout) :: RH integer , intent(out) :: rc type(ESMF_Region_Flag), intent(in), optional :: zeroregion + ! ---------------------------------------------- ! local real(R8), pointer :: factorList(:) integer, pointer :: factorIndexList(:,:) type(ESMF_Field) :: field1, field2 - integer :: dbrc integer :: rank logical :: checkflag = .false. character(len=8) :: filename @@ -885,7 +1065,7 @@ subroutine shr_nuopc_methods_FB_FieldRegrid(FBin,fldin,FBout,fldout,RH,rc,zerore localzr = zeroregion endif - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) if (shr_nuopc_methods_FB_FldChk(FBin , trim(fldin) , rc=rc) .and. & shr_nuopc_methods_FB_FldChk(FBout, trim(fldout), rc=rc)) then @@ -902,10 +1082,10 @@ subroutine shr_nuopc_methods_FB_FieldRegrid(FBin,fldin,FBout,fldout,RH,rc,zerore if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return else call ESMF_LogWrite(trim(subname)//" field not found: "//& - trim(fldin)//","//trim(fldout), ESMF_LOGMSG_INFO, rc=dbrc) + trim(fldin)//","//trim(fldout), ESMF_LOGMSG_INFO) endif - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) call t_stopf(subname) end subroutine shr_nuopc_methods_FB_FieldRegrid @@ -931,12 +1111,11 @@ subroutine shr_nuopc_methods_State_reset(State, value, rc) integer :: fieldCount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) real(R8) :: lvalue - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_State_reset)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -959,7 +1138,7 @@ subroutine shr_nuopc_methods_State_reset(State, value, rc) deallocate(lfieldnamelist) if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_State_reset @@ -967,12 +1146,15 @@ end subroutine shr_nuopc_methods_State_reset !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_FB_average(FB, count, rc) + ! ---------------------------------------------- ! Set all fields to zero in FB ! ---------------------------------------------- + use med_constants_mod , only : R8 use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet + ! input/output variables type(ESMF_FieldBundle), intent(inout) :: FB integer , intent(in) :: count integer , intent(out) :: rc @@ -983,21 +1165,20 @@ subroutine shr_nuopc_methods_FB_average(FB, count, rc) character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) real(R8), pointer :: dataPtr1(:) real(R8), pointer :: dataPtr2(:,:) - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_FB_average)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS if (count == 0) then if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": WARNING count is 0", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": WARNING count is 0", ESMF_LOGMSG_INFO) end if - !call ESMF_LogWrite(trim(subname)//": WARNING count is 0 set avg to spval", ESMF_LOGMSG_INFO, rc=dbrc) + !call ESMF_LogWrite(trim(subname)//": WARNING count is 0 set avg to spval", ESMF_LOGMSG_INFO) !call shr_nuopc_methods_FB_reset(FB, value=spval, rc=rc) !if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1025,8 +1206,7 @@ subroutine shr_nuopc_methods_FB_average(FB, count, rc) enddo enddo else - call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return endif @@ -1036,7 +1216,7 @@ subroutine shr_nuopc_methods_FB_average(FB, count, rc) endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_average @@ -1062,11 +1242,10 @@ subroutine shr_nuopc_methods_FB_diagnose(FB, string, rc) character(len=CL) :: lstring real(R8), pointer :: dataPtr1d(:) real(R8), pointer :: dataPtr2d(:,:) - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_FB_diagnose)' ! ---------------------------------------------- - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS lstring = '' @@ -1110,18 +1289,17 @@ subroutine shr_nuopc_methods_FB_diagnose(FB, string, rc) endif else - call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR, & - line=__LINE__, file=u_FILE_u, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return endif - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) enddo ! Deallocate memory deallocate(lfieldnamelist) - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine shr_nuopc_methods_FB_diagnose @@ -1144,12 +1322,11 @@ subroutine shr_nuopc_methods_Array_diagnose(array, string, rc) ! local variables character(len=CS) :: lstring real(R8), pointer :: dataPtr3d(:,:,:) - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_Array_diagnose)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -1168,11 +1345,11 @@ subroutine shr_nuopc_methods_Array_diagnose(array, string, rc) minval(dataPtr3d), maxval(dataPtr3d), sum(dataPtr3d) if (dbug_flag > 1) then - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) end if if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_Array_diagnose @@ -1197,12 +1374,11 @@ subroutine shr_nuopc_methods_State_diagnose(State, string, rc) character(len=CS) :: lstring real(R8), pointer :: dataPtr1d(:) real(R8), pointer :: dataPtr2d(:,:) - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_State_diagnose)' ! ---------------------------------------------- if (dbug_flag > 5) then - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) endif lstring = '' @@ -1245,20 +1421,19 @@ subroutine shr_nuopc_methods_State_diagnose(State, string, rc) endif else - call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR, line=__LINE__, & - file=u_FILE_u, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return endif - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) enddo deallocate(lfieldnamelist) if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_State_diagnose @@ -1285,12 +1460,11 @@ subroutine shr_nuopc_methods_FB_Field_diagnose(FB, fieldname, string, rc) character(len=CS) :: lstring real(R8), pointer :: dataPtr1d(:) real(R8), pointer :: dataPtr2d(:,:) - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_FB_FieldDiagnose)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -1309,53 +1483,123 @@ subroutine shr_nuopc_methods_FB_Field_diagnose(FB, fieldname, string, rc) write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname), & minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) else - write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname), & - " no data" + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname)," no data" endif elseif (lrank == 2) then if (size(dataPtr2d) > 0) then write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname), & minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) else - write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname), & - " no data" + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname)," no data" endif else - call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR, line=__LINE__, & - file=u_FILE_u, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return endif - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_Field_diagnose !----------------------------------------------------------------------------- + subroutine shr_nuopc_methods_Field_diagnose(field, fieldname, string, rc) + + ! ---------------------------------------------- + ! Diagnose Field + ! ---------------------------------------------- + + use med_constants_mod, only : R8, CS + use ESMF , only : ESMF_Field, ESMF_FieldGet + + ! input/output variables + type(ESMF_Field) , intent(inout) :: field + character(len=*) , intent(in) :: fieldname + character(len=*) , intent(in), optional :: string + integer , intent(out) :: rc + + ! local variables + integer :: lrank + character(len=CS) :: lstring + real(R8), pointer :: dataPtr1d(:) + real(R8), pointer :: dataPtr2d(:,:) + character(len=*),parameter :: subname='(shr_nuopc_methods_FB_FieldDiagnose)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + lstring = '' + if (present(string)) then + lstring = trim(string) + endif + + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + call ESMF_FieldGet(field, farrayPtr=dataPtr1d, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (size(dataPtr1d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname), & + minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname)," no data" + endif + elseif (lrank == 2) then + call ESMF_FieldGet(field, farrayPtr=dataPtr2d, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (size(dataPtr2d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname), & + minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname)," no data" + endif + else + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_Field_diagnose + + !----------------------------------------------------------------------------- + subroutine shr_nuopc_methods_FB_copyFB2FB(FBout, FBin, rc) + ! ---------------------------------------------- ! Copy common field names from FBin to FBout ! ---------------------------------------------- + use ESMF, only : ESMF_FieldBundle + type(ESMF_FieldBundle), intent(inout) :: FBout type(ESMF_FieldBundle), intent(in) :: FBin integer , intent(out) :: rc - - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_FB_copyFB2FB)' + ! ---------------------------------------------- - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS call shr_nuopc_methods_FB_accum(FBout, FBin, copy=.true., rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_copyFB2FB @@ -1371,12 +1615,10 @@ subroutine shr_nuopc_methods_FB_copyFB2ST(STout, FBin, rc) type(ESMF_State) , intent(inout) :: STout type(ESMF_FieldBundle), intent(in) :: FBin integer , intent(out) :: rc - - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_FB_copyFB2ST)' if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -1384,7 +1626,7 @@ subroutine shr_nuopc_methods_FB_copyFB2ST(STout, FBin, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_copyFB2ST @@ -1400,11 +1642,11 @@ subroutine shr_nuopc_methods_FB_copyST2FB(FBout, STin, rc) type(ESMF_FieldBundle), intent(inout) :: FBout type(ESMF_State) , intent(in) :: STin integer , intent(out) :: rc - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_FB_copyST2FB)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -1412,7 +1654,7 @@ subroutine shr_nuopc_methods_FB_copyST2FB(FBout, STin, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_copyST2FB @@ -1441,11 +1683,11 @@ subroutine shr_nuopc_methods_FB_accumFB2FB(FBout, FBin, copy, rc) logical :: lcopy real(R8), pointer :: dataPtri1(:) , dataPtro1(:) real(R8), pointer :: dataPtri2(:,:), dataPtro2(:,:) - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_FB_accumFB2FB)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -1472,8 +1714,7 @@ subroutine shr_nuopc_methods_FB_accumFB2FB(FBout, FBin, copy, rc) if (lranki == 1 .and. lranko == 1) then if (.not.shr_nuopc_methods_FieldPtr_Compare(dataPtro1, dataPtri1, subname, rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr1 size ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=rc) + call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr1 size ", ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return endif @@ -1491,8 +1732,7 @@ subroutine shr_nuopc_methods_FB_accumFB2FB(FBout, FBin, copy, rc) elseif (lranki == 2 .and. lranko == 2) then if (.not.shr_nuopc_methods_FieldPtr_Compare(dataPtro2, dataPtri2, subname, rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr2 size ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=rc) + call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr2 size ", ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return endif @@ -1514,9 +1754,9 @@ subroutine shr_nuopc_methods_FB_accumFB2FB(FBout, FBin, copy, rc) else write(msgString,'(a,2i8)') trim(subname)//": ranki, ranko = ",lranki,lranko - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) call ESMF_LogWrite(trim(subname)//": ERROR ranki ranko not supported "//trim(lfieldnamelist(n)), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return @@ -1528,40 +1768,43 @@ subroutine shr_nuopc_methods_FB_accumFB2FB(FBout, FBin, copy, rc) deallocate(lfieldnamelist) if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_accumFB2FB !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_FB_accumST2FB(FBout, STin, copy, rc) + ! ---------------------------------------------- ! Accumulate common field names from State to FB ! If copy is passed in and true, the this is a copy ! ---------------------------------------------- - use med_constants_mod, only : R8 - use ESMF, only : ESMF_State, ESMF_FieldBundle - use ESMF, only : ESMF_StateGet, ESMF_FieldBundleGet - use ESMF, only : ESMF_STATEITEM_NOTFOUND, ESMF_StateItem_Flag + use med_constants_mod , only : R8 + use ESMF , only : ESMF_State, ESMF_FieldBundle + use ESMF , only : ESMF_StateGet, ESMF_FieldBundleGet + use ESMF , only : ESMF_STATEITEM_NOTFOUND, ESMF_StateItem_Flag + + ! input/output variables type(ESMF_FieldBundle), intent(inout) :: FBout type(ESMF_State) , intent(in) :: STin logical, optional , intent(in) :: copy integer , intent(out) :: rc ! local variables - integer :: i,j,n - integer :: fieldCount, lrankS, lrankB - logical :: lcopy - character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) - type(ESMF_StateItem_Flag) :: itemType - real(R8), pointer :: dataPtrS1(:) , dataPtrB1(:) - real(R8), pointer :: dataPtrS2(:,:), dataPtrB2(:,:) - integer :: dbrc + integer :: i,j,n + integer :: fieldCount, lrankS, lrankB + logical :: lcopy + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + type(ESMF_StateItem_Flag) :: itemType + real(R8), pointer :: dataPtrS1(:) , dataPtrB1(:) + real(R8), pointer :: dataPtrS2(:,:), dataPtrB2(:,:) character(len=*), parameter :: subname='(shr_nuopc_methods_FB_accumST2FB)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -1580,6 +1823,7 @@ subroutine shr_nuopc_methods_FB_accumST2FB(FBout, STin, copy, rc) call shr_nuopc_methods_State_GetFldPtr(STin, lfieldnamelist(n), dataPtrS1, dataPtrS2, lrankS, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBout, lfieldnamelist(n), dataPtrB1, dataPtrB2, lrankB, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1590,8 +1834,7 @@ subroutine shr_nuopc_methods_FB_accumST2FB(FBout, STin, copy, rc) elseif (lrankS == 1 .and. lrankB == 1) then if (.not.shr_nuopc_methods_FieldPtr_Compare(dataPtrS1, dataPtrB1, subname, rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr1 size ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=rc) + call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr1 size ", ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return endif @@ -1609,8 +1852,7 @@ subroutine shr_nuopc_methods_FB_accumST2FB(FBout, STin, copy, rc) elseif (lrankS == 2 .and. lrankB == 2) then if (.not.shr_nuopc_methods_FieldPtr_Compare(dataPtrS2, dataPtrB2, subname, rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr2 size ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=rc) + call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr2 size ", ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return endif @@ -1632,9 +1874,9 @@ subroutine shr_nuopc_methods_FB_accumST2FB(FBout, STin, copy, rc) else write(msgString,'(a,2i8)') trim(subname)//": rankB, ranks = ",lrankB,lrankS - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) call ESMF_LogWrite(trim(subname)//": ERROR rankB rankS not supported "//trim(lfieldnamelist(n)), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return @@ -1646,7 +1888,7 @@ subroutine shr_nuopc_methods_FB_accumST2FB(FBout, STin, copy, rc) deallocate(lfieldnamelist) if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_accumST2FB @@ -1676,11 +1918,11 @@ subroutine shr_nuopc_methods_FB_accumFB2ST(STout, FBin, copy, rc) type(ESMF_StateItem_Flag) :: itemType real(R8), pointer :: dataPtrS1(:), dataPtrB1(:) real(R8), pointer :: dataPtrS2(:,:), dataPtrB2(:,:) - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_FB_accumFB2ST)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -1751,9 +1993,9 @@ subroutine shr_nuopc_methods_FB_accumFB2ST(STout, FBin, copy, rc) else write(msgString,'(a,2i8)') trim(subname)//": rankB, ranks = ",lrankB,lrankS - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) call ESMF_LogWrite(trim(subname)//": ERROR rankB rankS not supported "//trim(lfieldnamelist(n)), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return @@ -1765,7 +2007,7 @@ subroutine shr_nuopc_methods_FB_accumFB2ST(STout, FBin, copy, rc) deallocate(lfieldnamelist) if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_accumFB2ST @@ -1786,12 +2028,11 @@ logical function shr_nuopc_methods_FB_FldChk(FB, fldname, rc) integer , intent(out) :: rc ! local variables - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_FB_FldChk)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -1807,7 +2048,7 @@ logical function shr_nuopc_methods_FB_FldChk(FB, fldname, rc) call ESMF_FieldBundleGet(FB, fieldName=trim(fldname), isPresent=isPresent, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) then call ESMF_LogWrite(trim(subname)//" Error checking field: "//trim(fldname), & - ESMF_LOGMSG_ERROR, rc=dbrc) + ESMF_LOGMSG_ERROR) return endif if (isPresent) then @@ -1815,7 +2056,7 @@ logical function shr_nuopc_methods_FB_FldChk(FB, fldname, rc) endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end function shr_nuopc_methods_FB_FldChk @@ -1823,15 +2064,18 @@ end function shr_nuopc_methods_FB_FldChk !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_Field_GetFldPtr(field, fldptr1, fldptr2, rank, abort, rc) + ! ---------------------------------------------- ! for a field, determine rank and return fldptr1 or fldptr2 ! abort is true by default and will abort if fldptr is not yet allocated in field ! rank returns 0, 1, or 2. 0 means fldptr not allocated and abort=false ! ---------------------------------------------- + use med_constants_mod , only : R8 use ESMF , only : ESMF_Field,ESMF_Mesh, ESMF_FieldGet, ESMF_MeshGet use ESMF , only : ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID, ESMF_FIELDSTATUS_COMPLETE + ! input/output variables type(ESMF_Field) , intent(in) :: field real(R8), pointer , intent(inout), optional :: fldptr1(:) real(R8), pointer , intent(inout), optional :: fldptr2(:,:) @@ -1843,17 +2087,16 @@ subroutine shr_nuopc_methods_Field_GetFldPtr(field, fldptr1, fldptr2, rank, abor type(ESMF_Mesh) :: lmesh integer :: lrank, nnodes, nelements logical :: labort - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_Field_GetFldPtr)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif if (.not.present(rc)) then call ESMF_LogWrite(trim(subname)//": ERROR rc not present ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif @@ -1886,14 +2129,17 @@ subroutine shr_nuopc_methods_Field_GetFldPtr(field, fldptr1, fldptr2, rank, abor if (geomtype == ESMF_GEOMTYPE_GRID) then call ESMF_FieldGet(field, rank=lrank, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + elseif (geomtype == ESMF_GEOMTYPE_MESH) then - lrank = 1 + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(field, mesh=lmesh, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (nnodes == 0 .and. nelements == 0) lrank = 0 - else ! geomtype + + else call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", & ESMF_LOGMSG_INFO, rc=rc) rc = ESMF_FAILURE @@ -1902,28 +2148,31 @@ subroutine shr_nuopc_methods_Field_GetFldPtr(field, fldptr1, fldptr2, rank, abor if (lrank == 0) then call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) + elseif (lrank == 1) then if (.not.present(fldptr1)) then call ESMF_LogWrite(trim(subname)//": ERROR missing rank=1 array ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif call ESMF_FieldGet(field, farrayPtr=fldptr1, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + elseif (lrank == 2) then if (.not.present(fldptr2)) then call ESMF_LogWrite(trim(subname)//": ERROR missing rank=2 array ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif call ESMF_FieldGet(field, farrayPtr=fldptr2, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + else call ESMF_LogWrite(trim(subname)//": ERROR in rank ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif @@ -1935,7 +2184,7 @@ subroutine shr_nuopc_methods_Field_GetFldPtr(field, fldptr1, fldptr2, rank, abor endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_Field_GetFldPtr @@ -1943,12 +2192,14 @@ end subroutine shr_nuopc_methods_Field_GetFldPtr !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_FB_GetFldPtr(FB, fldname, fldptr1, fldptr2, rank, field, rc) + use med_constants_mod , only : R8 use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_Field ! ---------------------------------------------- ! Get pointer to a field bundle field ! ---------------------------------------------- + type(ESMF_FieldBundle) , intent(in) :: FB character(len=*) , intent(in) :: fldname real(R8), pointer , intent(inout), optional :: fldptr1(:) @@ -1960,17 +2211,16 @@ subroutine shr_nuopc_methods_FB_GetFldPtr(FB, fldname, fldptr1, fldptr2, rank, f ! local variables type(ESMF_Field) :: lfield integer :: lrank - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_FB_GetFldPtr)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif if (.not.present(rc)) then call ESMF_LogWrite(trim(subname)//": ERROR rc not present "//trim(fldname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif @@ -1979,7 +2229,7 @@ subroutine shr_nuopc_methods_FB_GetFldPtr(FB, fldname, fldptr1, fldptr2, rank, f if (.not. shr_nuopc_methods_FB_FldChk(FB, trim(fldname), rc=rc)) then call ESMF_LogWrite(trim(subname)//": ERROR field "//trim(fldname)//" not in FB ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif @@ -1998,7 +2248,7 @@ subroutine shr_nuopc_methods_FB_GetFldPtr(FB, fldname, fldptr1, fldptr2, rank, f field = lfield endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_GetFldPtr @@ -2019,11 +2269,11 @@ subroutine shr_nuopc_methods_FB_SetFldPtr(FB, fldname, val, rc) integer :: lrank real(R8), pointer :: fldptr1(:) real(R8), pointer :: fldptr2(:,:) - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_FB_SetFldPtr)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -2038,13 +2288,13 @@ subroutine shr_nuopc_methods_FB_SetFldPtr(FB, fldname, val, rc) fldptr2 = val else call ESMF_LogWrite(trim(subname)//": ERROR in rank "//trim(fldname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_SetFldPtr @@ -2068,17 +2318,16 @@ subroutine shr_nuopc_methods_State_GetFldPtr(ST, fldname, fldptr1, fldptr2, rank ! local variables type(ESMF_Field) :: lfield integer :: lrank - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_State_GetFldPtr)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif if (.not.present(rc)) then call ESMF_LogWrite(trim(subname)//": ERROR rc not present "//trim(fldname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif @@ -2097,7 +2346,7 @@ subroutine shr_nuopc_methods_State_GetFldPtr(ST, fldname, fldptr1, fldptr2, rank endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_State_GetFldPtr @@ -2118,11 +2367,11 @@ subroutine shr_nuopc_methods_State_SetFldPtr(ST, fldname, val, rc) integer :: lrank real(R8), pointer :: fldptr1(:) real(R8), pointer :: fldptr2(:,:) - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_State_SetFldPtr)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -2137,13 +2386,13 @@ subroutine shr_nuopc_methods_State_SetFldPtr(ST, fldname, val, rc) fldptr2 = val else call ESMF_LogWrite(trim(subname)//": ERROR in rank "//trim(fldname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_State_SetFldPtr @@ -2151,18 +2400,20 @@ end subroutine shr_nuopc_methods_State_SetFldPtr !----------------------------------------------------------------------------- logical function shr_nuopc_methods_FieldPtr_Compare1(fldptr1, fldptr2, cstring, rc) + use med_constants_mod, only : R8 + real(R8), pointer, intent(in) :: fldptr1(:) real(R8), pointer, intent(in) :: fldptr2(:) character(len=*) , intent(in) :: cstring integer , intent(out) :: rc ! local variables - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_FieldPtr_Compare1)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -2172,15 +2423,15 @@ logical function shr_nuopc_methods_FieldPtr_Compare1(fldptr1, fldptr2, cstring, call ESMF_LogWrite(trim(subname)//": ERROR in data size "//trim(cstring), ESMF_LOGMSG_ERROR, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write(msgString,*) trim(subname)//': fldptr1 ',lbound(fldptr1),ubound(fldptr1) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) write(msgString,*) trim(subname)//': fldptr2 ',lbound(fldptr2),ubound(fldptr2) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) else shr_nuopc_methods_FieldPtr_Compare1 = .true. endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end function shr_nuopc_methods_FieldPtr_Compare1 @@ -2195,11 +2446,11 @@ logical function shr_nuopc_methods_FieldPtr_Compare2(fldptr1, fldptr2, cstring, integer , intent(out) :: rc ! local variables - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_FieldPtr_Compare2)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -2211,15 +2462,15 @@ logical function shr_nuopc_methods_FieldPtr_Compare2(fldptr1, fldptr2, cstring, call ESMF_LogWrite(trim(subname)//": ERROR in data size "//trim(cstring), ESMF_LOGMSG_ERROR, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write(msgString,*) trim(subname)//': fldptr2 ',lbound(fldptr2),ubound(fldptr2) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) write(msgString,*) trim(subname)//': fldptr1 ',lbound(fldptr1),ubound(fldptr1) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) else shr_nuopc_methods_FieldPtr_Compare2 = .true. endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end function shr_nuopc_methods_FieldPtr_Compare2 @@ -2234,11 +2485,11 @@ subroutine shr_nuopc_methods_State_GeomPrint(state, string, rc) type(ESMF_Field) :: lfield integer :: fieldcount - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_State_GeomPrint)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -2251,11 +2502,11 @@ subroutine shr_nuopc_methods_State_GeomPrint(state, string, rc) call shr_nuopc_methods_Field_GeomPrint(lfield, string, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return else - call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO) endif ! fieldCount > 0 if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_State_GeomPrint @@ -2271,11 +2522,11 @@ subroutine shr_nuopc_methods_FB_GeomPrint(FB, string, rc) type(ESMF_Field) :: lfield integer :: fieldcount - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_FB_GeomPrint)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -2287,11 +2538,11 @@ subroutine shr_nuopc_methods_FB_GeomPrint(FB, string, rc) call shr_nuopc_methods_Field_GeomPrint(lfield, string, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return else - call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO) endif ! fieldCount > 0 if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_GeomPrint @@ -2299,24 +2550,27 @@ end subroutine shr_nuopc_methods_FB_GeomPrint !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_Field_GeomPrint(field, string, rc) + use med_constants_mod, only : R8 use ESMF, only : ESMF_Field, ESMF_Grid, ESMF_Mesh use ESMF, only : ESMF_FieldGet, ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID, ESMF_FIELDSTATUS_EMPTY + ! input/output variables type(ESMF_Field), intent(in) :: field character(len=*), intent(in) :: string integer , intent(out) :: rc - type(ESMF_Grid) :: lgrid - type(ESMF_Mesh) :: lmesh - integer :: lrank + ! local variables + type(ESMF_Grid) :: lgrid + type(ESMF_Mesh) :: lmesh + integer :: lrank real(R8), pointer :: dataPtr1(:) real(R8), pointer :: dataPtr2(:,:) - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_Field_GeomPrint)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -2324,7 +2578,7 @@ subroutine shr_nuopc_methods_Field_GeomPrint(field, string, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (status == ESMF_FIELDSTATUS_EMPTY) then call ESMF_LogWrite(trim(subname)//":"//trim(string)//": ERROR field does not have a geom yet ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif @@ -2366,13 +2620,13 @@ subroutine shr_nuopc_methods_Field_GeomPrint(field, string, rc) continue else call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_Field_GeomPrint @@ -2396,11 +2650,11 @@ subroutine shr_nuopc_methods_Mesh_Print(mesh, string, rc) integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) type(ESMF_MeshStatus_Flag) :: meshStatus logical :: elemDGPresent, nodeDGPresent - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_Mesh_Print)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -2541,7 +2795,7 @@ subroutine shr_nuopc_methods_Mesh_Print(mesh, string, rc) endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_Mesh_Print @@ -2549,10 +2803,12 @@ end subroutine shr_nuopc_methods_Mesh_Print !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_Grid_Print(grid, string, rc) + use med_constants_mod, only : R8 use ESMF, only : ESMF_Grid, ESMF_DistGrid, ESMF_StaggerLoc use ESMF, only : ESMF_GridGet, ESMF_DistGridGet, ESMF_GridGetCoord use ESMF, only : ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER + type(ESMF_Grid) , intent(in) :: grid character(len=*), intent(in) :: string integer , intent(out) :: rc @@ -2568,11 +2824,11 @@ subroutine shr_nuopc_methods_Grid_Print(grid, string, rc) real(R8), pointer :: fldptr1(:) real(R8), pointer :: fldptr2(:,:) integer :: n1,n2,n3 - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_Grid_Print)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -2680,7 +2936,7 @@ subroutine shr_nuopc_methods_Grid_Print(grid, string, rc) enddo if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_Grid_Print @@ -2702,13 +2958,13 @@ subroutine shr_nuopc_methods_Clock_TimePrint(clock,string,rc) type(ESMF_TimeInterval) :: timeStep character(len=CS) :: timestr character(len=CL) :: lstring - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_Clock_TimePrint)' + ! ---------------------------------------------- rc = ESMF_SUCCESS if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif if (present(string)) then @@ -2721,28 +2977,28 @@ subroutine shr_nuopc_methods_Clock_TimePrint(clock,string,rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(time,timestring=timestr,rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(lstring)//": currtime = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(lstring)//": currtime = "//trim(timestr), ESMF_LOGMSG_INFO) call ESMF_ClockGet(clock,starttime=time,rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(time,timestring=timestr,rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(lstring)//": startime = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(lstring)//": startime = "//trim(timestr), ESMF_LOGMSG_INFO) call ESMF_ClockGet(clock,stoptime=time,rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(time,timestring=timestr,rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(lstring)//": stoptime = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(lstring)//": stoptime = "//trim(timestr), ESMF_LOGMSG_INFO) call ESMF_ClockGet(clock,timestep=timestep,rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeIntervalGet(timestep,timestring=timestr,rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(lstring)//": timestep = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(lstring)//": timestep = "//trim(timestr), ESMF_LOGMSG_INFO) if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_Clock_TimePrint @@ -2765,12 +3021,12 @@ subroutine shr_nuopc_methods_Mesh_Write(mesh, string, rc) type(ESMF_Array) :: array real(R8), pointer :: rawdata(:) real(R8), pointer :: coord(:) - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_Mesh_Write)' + ! ---------------------------------------------- rc = ESMF_SUCCESS if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif #if (1 == 0) @@ -2834,11 +3090,11 @@ subroutine shr_nuopc_methods_Mesh_Write(mesh, string, rc) deallocate(rawdata,coord) #else - call ESMF_LogWrite(trim(subname)//": turned off right now", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": turned off right now", ESMF_LOGMSG_INFO) #endif if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_Mesh_Write @@ -2853,11 +3109,11 @@ subroutine shr_nuopc_methods_State_GeomWrite(state, string, rc) type(ESMF_Field) :: lfield integer :: fieldcount - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_State_GeomWrite)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -2870,11 +3126,11 @@ subroutine shr_nuopc_methods_State_GeomWrite(state, string, rc) call shr_nuopc_methods_Field_GeomWrite(lfield, string, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return else - call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO) endif ! fieldCount > 0 if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_State_GeomWrite @@ -2890,11 +3146,11 @@ subroutine shr_nuopc_methods_FB_GeomWrite(FB, string, rc) type(ESMF_Field) :: lfield integer :: fieldcount - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_FB_GeomWrite)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -2907,11 +3163,11 @@ subroutine shr_nuopc_methods_FB_GeomWrite(FB, string, rc) call shr_nuopc_methods_Field_GeomWrite(lfield, string, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return else - call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO) endif ! fieldCount > 0 if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_GeomWrite @@ -2919,27 +3175,30 @@ end subroutine shr_nuopc_methods_FB_GeomWrite !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_Field_GeomWrite(field, string, rc) + use ESMF, only : ESMF_Field, ESMF_Grid, ESMF_Mesh, ESMF_FIeldGet, ESMF_FIELDSTATUS_EMPTY use ESMF, only : ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID + ! input/output variables type(ESMF_Field), intent(in) :: field character(len=*), intent(in) :: string integer , intent(out) :: rc + ! local variables type(ESMF_Grid) :: lgrid type(ESMF_Mesh) :: lmesh - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_Field_GeomWrite)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS call ESMF_FieldGet(field, status=status, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (status == ESMF_FIELDSTATUS_EMPTY) then - call ESMF_LogWrite(trim(subname)//":"//trim(string)//": ERROR field does not have a geom yet ", ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + call ESMF_LogWrite(trim(subname)//":"//trim(string)//": ERROR field does not have a geom yet ") rc = ESMF_FAILURE return endif @@ -2960,7 +3219,7 @@ subroutine shr_nuopc_methods_Field_GeomWrite(field, string, rc) endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_Field_GeomWrite @@ -2983,12 +3242,12 @@ subroutine shr_nuopc_methods_Grid_Write(grid, string, rc) ! local type(ESMF_Array) :: array character(len=CS) :: name - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_Grid_Write)' + ! ---------------------------------------------- rc = ESMF_SUCCESS if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif ! -- centers -- @@ -3094,7 +3353,7 @@ subroutine shr_nuopc_methods_Grid_Write(grid, string, rc) endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_Grid_Write @@ -3114,11 +3373,11 @@ logical function shr_nuopc_methods_Distgrid_Match(distGrid1, distGrid2, rc) integer, allocatable :: minIndexPTile1(:,:), minIndexPTile2(:,:) integer, allocatable :: maxIndexPTile1(:,:), maxIndexPTile2(:,:) integer, allocatable :: elementCountPTile1(:), elementCountPTile2(:) - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_Distgrid_Match)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(subname//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//": called", ESMF_LOGMSG_INFO) endif if(present(rc)) rc = ESMF_SUCCESS @@ -3136,7 +3395,7 @@ logical function shr_nuopc_methods_Distgrid_Match(distGrid1, distGrid2, rc) shr_nuopc_methods_Distgrid_Match = .false. if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": Grid dimCount MISMATCH ", & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) endif endif @@ -3144,7 +3403,7 @@ logical function shr_nuopc_methods_Distgrid_Match(distGrid1, distGrid2, rc) shr_nuopc_methods_Distgrid_Match = .false. if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": Grid tileCount MISMATCH ", & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) endif endif @@ -3171,7 +3430,7 @@ logical function shr_nuopc_methods_Distgrid_Match(distGrid1, distGrid2, rc) shr_nuopc_methods_Distgrid_Match = .false. if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": Grid elementCountPTile MISMATCH ", & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) endif endif @@ -3179,7 +3438,7 @@ logical function shr_nuopc_methods_Distgrid_Match(distGrid1, distGrid2, rc) shr_nuopc_methods_Distgrid_Match = .false. if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": Grid minIndexPTile MISMATCH ", & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) endif endif @@ -3187,7 +3446,7 @@ logical function shr_nuopc_methods_Distgrid_Match(distGrid1, distGrid2, rc) shr_nuopc_methods_Distgrid_Match = .false. if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": Grid maxIndexPTile MISMATCH ", & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) endif endif @@ -3200,28 +3459,30 @@ logical function shr_nuopc_methods_Distgrid_Match(distGrid1, distGrid2, rc) ! TODO: Optionally Check Coordinates - if (dbug_flag > 10) then - call ESMF_LogWrite(subname//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//": done", ESMF_LOGMSG_INFO) endif end function shr_nuopc_methods_Distgrid_Match !================================================================================ - subroutine shr_nuopc_methods_State_GetScalar(State, scalar_id, value, flds_scalar_name, flds_scalar_num, rc) + subroutine shr_nuopc_methods_State_GetScalar(state, scalar_id, scalar_value, flds_scalar_name, flds_scalar_num, rc) + + ! ---------------------------------------------- + ! Get scalar data from State for a particular name and broadcast it to all other pets + ! ---------------------------------------------- + use med_constants_mod , only : R8 use ESMF , only : ESMF_SUCCESS, ESMF_State, ESMF_StateGet, ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_FAILURE, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_LogWrite use ESMF , only : ESMF_LOGMSG_INFO, ESMF_VM, ESMF_VMBroadCast, ESMF_VMGetCurrent use ESMF , only : ESMF_VMGet - ! ---------------------------------------------- - ! Get scalar data from State for a particular name and broadcast it to all other pets - ! ---------------------------------------------- - type(ESMF_State), intent(in) :: State + ! input/output variables + type(ESMF_State), intent(in) :: state integer, intent(in) :: scalar_id - real(R8), intent(out) :: value + real(R8), intent(out) :: scalar_value character(len=*), intent(in) :: flds_scalar_name integer, intent(in) :: flds_scalar_num integer, intent(inout) :: rc @@ -3232,8 +3493,8 @@ subroutine shr_nuopc_methods_State_GetScalar(State, scalar_id, value, flds_scala type(ESMF_Field) :: field real(R8), pointer :: farrayptr(:,:) real(r8) :: tmp(1) - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_State_GetScalar)' + ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -3250,7 +3511,7 @@ subroutine shr_nuopc_methods_State_GetScalar(State, scalar_id, value, flds_scala call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then - call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return endif @@ -3258,21 +3519,24 @@ subroutine shr_nuopc_methods_State_GetScalar(State, scalar_id, value, flds_scala endif call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - value = tmp(1) - + scalar_value = tmp(1) end subroutine shr_nuopc_methods_State_GetScalar !================================================================================ - subroutine shr_nuopc_methods_State_SetScalar(value, scalar_id, State, flds_scalar_name, flds_scalar_num, rc) + subroutine shr_nuopc_methods_State_SetScalar(scalar_value, scalar_id, State, flds_scalar_name, flds_scalar_num, rc) + ! ---------------------------------------------- ! Set scalar data from State for a particular name ! ---------------------------------------------- + use med_constants_mod , only : R8 use ESMF , only : ESMF_Field, ESMF_State, ESMF_StateGet, ESMF_FieldGet use ESMF , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet - real(R8), intent(in) :: value + + ! input/output arguments + real(R8), intent(in) :: scalar_value integer, intent(in) :: scalar_id type(ESMF_State), intent(inout) :: State character(len=*), intent(in) :: flds_scalar_name @@ -3284,8 +3548,8 @@ subroutine shr_nuopc_methods_State_SetScalar(value, scalar_id, State, flds_scala type(ESMF_Field) :: field type(ESMF_VM) :: vm real(R8), pointer :: farrayptr(:,:) - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_State_SetScalar)' + ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -3302,11 +3566,11 @@ subroutine shr_nuopc_methods_State_SetScalar(value, scalar_id, State, flds_scala call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then - call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO) rc = ESMF_FAILURE - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + return endif - farrayptr(scalar_id,1) = value + farrayptr(scalar_id,1) = scalar_value endif end subroutine shr_nuopc_methods_State_SetScalar @@ -3314,9 +3578,11 @@ end subroutine shr_nuopc_methods_State_SetScalar !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_State_UpdateTimestamp(state, time, rc) + use NUOPC , only : NUOPC_GetStateMemberLists use ESMF , only : ESMF_State, ESMF_Time, ESMF_Field, ESMF_SUCCESS + ! input/output variables type(ESMF_State) , intent(inout) :: state type(ESMF_Time) , intent(in) :: time integer , intent(out) :: rc @@ -3324,8 +3590,8 @@ subroutine shr_nuopc_methods_State_UpdateTimestamp(state, time, rc) ! local variables integer :: i type(ESMF_Field),pointer :: fieldList(:) - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_State_UpdateTimestamp)' + ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -3342,16 +3608,18 @@ end subroutine shr_nuopc_methods_State_UpdateTimestamp !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_Field_UpdateTimestamp(field, time, rc) + use ESMF, only : ESMF_Field, ESMF_Time, ESMF_TimeGet, ESMF_AttributeSet, ESMF_ATTNEST_ON, ESMF_SUCCESS + ! input/output variables type(ESMF_Field) , intent(inout) :: field type(ESMF_Time) , intent(in) :: time integer , intent(out) :: rc ! local variables integer :: yy, mm, dd, h, m, s, ms, us, ns - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_Field_UpdateTimestamp)' + ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -3369,19 +3637,20 @@ end subroutine shr_nuopc_methods_Field_UpdateTimestamp !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_Print_FieldExchInfo(flag, values, logunit, fldlist, nflds, istr) - use shr_nuopc_utils_mod , only : shr_nuopc_string_listGetName - use med_constants_mod , only : R8 - use ESMF , only : ESMF_MAXSTR - ! !DESCRIPTION: + ! ---------------------------------------------- ! Print out information about values to stdount ! - flag sets the level of information: ! - print out names of fields in values 2d array ! - also print out local max and min of data in values 2d array ! If optional argument istr is present, it will be output before any of the information. + ! ---------------------------------------------- + use shr_nuopc_utils_mod , only : shr_nuopc_string_listGetName + use med_constants_mod , only : R8 + use ESMF , only : ESMF_MAXSTR - ! !INPUT/OUTPUT PARAMETERS: + ! input/output variables integer , intent(in) :: flag ! info level flag real(R8) , intent(in) :: values(:,:) ! arrays sent to/recieved from mediator integer , intent(in) :: logunit @@ -3389,19 +3658,17 @@ subroutine shr_nuopc_methods_Print_FieldExchInfo(flag, values, logunit, fldlist, integer , intent(in) :: nflds character(*) , intent(in),optional :: istr ! string for print - !--- local --- + ! local variables integer :: n ! generic indicies integer :: nsize ! grid point in values array real(R8) :: minl(nflds) ! local min real(R8) :: maxl(nflds) ! local max character(len=ESMF_MAXSTR) :: name - - !--- formats --- - character(*),parameter :: subName = '(shr_nuopc_methods_Print_FieldExchInfo) ' - character(*),parameter :: F00 = "('(shr_nuopc_methods_Print_FieldExchInfo) ',8a)" - character(*),parameter :: F01 = "('(shr_nuopc_methods_Print_FieldExchInfo) ',a,i9)" - character(*),parameter :: F02 = "('(shr_nuopc_methods_Print_FieldExchInfo) ',240a)" - character(*),parameter :: F03 = "('(shr_nuopc_methods_Print_FieldExchInfo) ',a,2es11.3,i4,2x,a)" + character(*),parameter :: subName = '(shr_nuopc_methods_Print_FieldExchInfo) ' + character(*),parameter :: F00 = "('(shr_nuopc_methods_Print_FieldExchInfo) ',8a)" + character(*),parameter :: F01 = "('(shr_nuopc_methods_Print_FieldExchInfo) ',a,i9)" + character(*),parameter :: F02 = "('(shr_nuopc_methods_Print_FieldExchInfo) ',240a)" + character(*),parameter :: F03 = "('(shr_nuopc_methods_Print_FieldExchInfo) ',a,2es11.3,i4,2x,a)" !------------------------------------------------------------------------------- if (flag >= 1) then @@ -3441,12 +3708,13 @@ subroutine shr_nuopc_methods_State_FldDebug(state, flds_scalar_name, prefix, ymd integer , intent(out) :: rc ! local variables - integer :: n, nfld, nlev + integer :: n, nfld, ungridded_index integer :: lsize real(R8), pointer :: dataPtr1d(:) real(R8), pointer :: dataPtr2d(:,:) integer :: fieldCount integer :: ungriddedUBound(1) + integer :: gridToFieldMap(1) character(len=ESMF_MAXSTR) :: string type(ESMF_Field) , allocatable :: lfields(:) integer , allocatable :: dimCounts(:) @@ -3456,11 +3724,14 @@ subroutine shr_nuopc_methods_State_FldDebug(state, flds_scalar_name, prefix, ymd ! Determine the list of fields and the dimension count for each field call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(fieldNameList(fieldCount)) allocate(lfields(fieldCount)) allocate(dimCounts(fieldCount)) + call ESMF_StateGet(state, itemNameList=fieldNameList, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + do nfld=1, fieldCount call ESMF_StateGet(state, itemName=trim(fieldNameList(nfld)), field=lfields(nfld), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -3487,23 +3758,31 @@ subroutine shr_nuopc_methods_State_FldDebug(state, flds_scalar_name, prefix, ymd if (trim(fieldNameList(nfld)) /= flds_scalar_name .and. dataPtr1d(n) /= 0.) then string = trim(prefix) // ' ymd, tod, index, '// trim(fieldNameList(nfld)) //' = ' write(logunit,100) trim(string), ymd, tod, n, dataPtr1d(n) -100 format(a60,3(i8,2x),d21.14) end if else if (dimCounts(nfld) == 2) then - call ESMF_FieldGet(lfields(nfld), farrayPtr=dataPtr2d, rc=rc) + call ESMF_FieldGet(lfields(nfld), ungriddedUBound=ungriddedUBound, gridtoFieldMap=gridToFieldMap, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfields(nfld), ungriddedUBound=ungriddedUBound, rc=rc) call ESMF_FieldGet(lfields(nfld), farrayPtr=dataPtr2d, rc=rc) - do nlev = 1,ungriddedUBound(1) - if (trim(fieldNameList(nfld)) /= flds_scalar_name .and. dataPtr2d(n,nlev) /= 0.) then + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + do ungridded_index = 1,ungriddedUBound(1) + if (trim(fieldNameList(nfld)) /= flds_scalar_name) then string = trim(prefix) // ' ymd, tod, lev, index, '// trim(fieldNameList(nfld)) //' = ' - write(logunit,101) trim(string), ymd, tod, nlev, n, dataPtr2d(n,nlev) -101 format(a60,4(i8,2x),d21.14) + if (gridToFieldMap(1) == 1) then + if (dataPtr2d(n,ungridded_index) /= 0.) then + write(logunit,101) trim(string), ymd, tod, ungridded_index, n, dataPtr2d(n,ungridded_index) + end if + else if (gridToFieldMap(1) == 2) then + if (dataPtr2d(ungridded_index,n) /= 0.) then + write(logunit,101) trim(string), ymd, tod, ungridded_index, n, dataPtr2d(ungridded_index,n) + end if + end if end if end do end if end do end do +100 format(a60,3(i8,2x),d21.14) +101 format(a60,4(i8,2x),d21.14) deallocate(fieldNameList) deallocate(lfields) @@ -3527,15 +3806,12 @@ subroutine shr_nuopc_methods_FB_getNumFlds(FB, string, nflds, rc) character(len=*) , intent(in) :: string integer , intent(out) :: nflds integer , intent(inout) :: rc - - ! local variables - integer :: dbrc ! ---------------------------------------------- rc = ESMF_SUCCESS if (.not. ESMF_FieldBundleIsCreated(FB)) then - call ESMF_LogWrite(trim(string)//": has not been created, returning", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(string)//": has not been created, returning", ESMF_LOGMSG_INFO) nflds = 0 else ! Note - the scalar field has been removed from all mediator @@ -3544,7 +3820,7 @@ subroutine shr_nuopc_methods_FB_getNumFlds(FB, string, nflds, rc) call ESMF_FieldBundleGet(FB, fieldCount=nflds, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return if (nflds == 0) then - call ESMF_LogWrite(trim(string)//": only has scalar data, returning", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(string)//": only has scalar data, returning", ESMF_LOGMSG_INFO) end if end if diff --git a/src/drivers/nuopc/shr/shr_nuopc_utils_mod.F90 b/src/drivers/nuopc/shr/shr_nuopc_utils_mod.F90 index 8d3b30f05e39..7ad4c1076a9c 100644 --- a/src/drivers/nuopc/shr/shr_nuopc_utils_mod.F90 +++ b/src/drivers/nuopc/shr/shr_nuopc_utils_mod.F90 @@ -15,7 +15,10 @@ module shr_nuopc_utils_mod integer, parameter :: memdebug_level=1 character(*),parameter :: u_FILE_u = __FILE__ +!=============================================================================== contains +!=============================================================================== + subroutine shr_nuopc_memcheck(string, level, mastertask) character(len=*), intent(in) :: string integer, intent(in) :: level @@ -27,19 +30,27 @@ subroutine shr_nuopc_memcheck(string, level, mastertask) endif end subroutine shr_nuopc_memcheck +!=============================================================================== + subroutine shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - use ESMF, only : ESMF_SUCCESS, ESMF_GridComp - use NUOPC, only : NUOPC_CompAttributeGet - type(ESMF_GridComp) :: gcomp + use ESMF , only : ESMF_SUCCESS, ESMF_GridComp + use NUOPC , only : NUOPC_CompAttributeGet + + ! input/output variables + type(ESMF_GridComp) :: gcomp character(len=*), intent(out) :: inst_suffix - integer, intent(out) :: inst_index - integer :: rc - logical :: isPresent - character(len=4) :: cvalue + integer, intent(out) :: inst_index + + ! local variables + integer :: rc + logical :: isPresent + character(len=4) :: cvalue + !----------------------------------------------------------------------- call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", isPresent=isPresent, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", value=inst_suffix, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -52,38 +63,53 @@ subroutine shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) end subroutine shr_nuopc_get_component_instance +!=============================================================================== + subroutine shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit, shrloglev) - use ESMF, only : ESMF_GridComp, ESMF_VM, ESMF_VMGet, ESMF_GridCompGet - use NUOPC, only : NUOPC_CompAttributeGet - use med_constants_mod, only : shr_file_getunit, shr_file_getLogUnit, shr_file_getLogLevel - use med_constants_mod, only : shr_file_setLogLevel, CL, shr_file_setlogunit - type(ESMF_GridComp) :: gcomp - logical, intent(in) :: mastertask + use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_VMGet, ESMF_GridCompGet + use NUOPC , only : NUOPC_CompAttributeGet + use med_constants_mod , only : shr_file_getunit, shr_file_getLogUnit + use med_constants_mod , only : shr_file_setLogLevel, CL, shr_file_setlogunit + + ! input/output variables + type(ESMF_GridComp) :: gcomp + logical, intent(in) :: mastertask integer, intent(out) :: logunit integer, intent(out) :: shrlogunit - integer, intent(out) :: shrloglev + integer, intent(out), optional :: shrloglev + ! local variables character(len=CL) :: diro character(len=CL) :: logfile - integer :: rc + integer :: rc + !----------------------------------------------------------------------- + shrlogunit = 6 + if (mastertask) then call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) else logUnit = 6 endif + call shr_file_setLogUnit (logunit) + end subroutine shr_nuopc_set_component_logging +!=============================================================================== + logical function shr_nuopc_utils_ChkErr(rc, line, file, mpierr) + use mpi , only : MPI_ERROR_STRING, MPI_MAX_ERROR_STRING, MPI_SUCCESS use ESMF, only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO use ESMF, only : ESMF_FAILURE, ESMF_LogWrite + integer, intent(in) :: rc integer, intent(in) :: line @@ -108,7 +134,8 @@ logical function shr_nuopc_utils_ChkErr(rc, line, file, mpierr) end function shr_nuopc_utils_ChkErr - !----------------------------------------------------------------------------- +!=============================================================================== + subroutine shr_nuopc_log_clock_advance(clock, component, logunit) use ESMF, only : ESMF_Clock, ESMF_ClockPrint use med_constants_mod, only : CL @@ -133,5 +160,4 @@ subroutine shr_nuopc_log_clock_advance(clock, component, logunit) end subroutine shr_nuopc_log_clock_advance - end module shr_nuopc_utils_mod From dadcc97edc3b2b0df1bf670e4cd71e2ff68043f8 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 24 Apr 2019 10:44:38 -0600 Subject: [PATCH 48/54] update netcdf for mpi-serial --- config/cesm/machines/config_machines.xml | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/config/cesm/machines/config_machines.xml b/config/cesm/machines/config_machines.xml index 343750a56926..9f8b18dfc192 100644 --- a/config/cesm/machines/config_machines.xml +++ b/config/cesm/machines/config_machines.xml @@ -406,12 +406,12 @@ This allows using a different mpirun command to launch unit tests netcdf/4.6.1 + + netcdf/4.6.1 + netcdf/4.4.1.1 - - netcdf/4.5.0 - 256M @@ -420,8 +420,13 @@ This allows using a different mpirun command to launch unit tests 1 + + /glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default/esmf.mk + + + /glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libg/Linux.intel.64.mpt.default/esmf.mk + - /glade/u/home/turuncu/progs/esmf-8.0.0b29/install_dir/lib/libO/Linux.intel.64.mpt.default/esmf.mk ON SUMMARY /glade/work/dunlap/FV3GFS/benchmark-20181016/ From 57e6a2e746795d57aec0e8e2d035ed16f344f86b Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 25 Apr 2019 12:42:27 -0700 Subject: [PATCH 49/54] fix for edison --- config/cesm/machines/config_machines.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config/cesm/machines/config_machines.xml b/config/cesm/machines/config_machines.xml index 9f8b18dfc192..d229824305f7 100644 --- a/config/cesm/machines/config_machines.xml +++ b/config/cesm/machines/config_machines.xml @@ -949,7 +949,7 @@ This allows using a different mpirun command to launch unit tests /global/project/projectdirs/ccsm1/modulefiles/edison - esmf/6.3.0rp1-defio-intel17.0-mpi-O + esmf/7.1.0r-defio-intel18.0.1.163-mpi-O esmf/6.3.0rp1-defio-intel17.0-mpiuni-O From 9ab758dc9ea6f335c979f1c1379cc15a01e0ada8 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 25 Apr 2019 15:07:21 -0600 Subject: [PATCH 50/54] Change DATM_CLMNCEP_YR_ALIGN for present-day compsets The land group wants DATM_CLMNCEP_YR_ALIGN to match DATM_CLMNCEP_YR_START for present-day compsets. This will make the model year align with the forcing year. --- .../datm/cime_config/config_component.xml | 21 ++++++++++--------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/src/components/data_comps/datm/cime_config/config_component.xml b/src/components/data_comps/datm/cime_config/config_component.xml index 11ef218e9a0e..ed9540b58e2c 100644 --- a/src/components/data_comps/datm/cime_config/config_component.xml +++ b/src/components/data_comps/datm/cime_config/config_component.xml @@ -187,30 +187,31 @@ 1 - 1 + 1972 1 1 1 - 1 + 2000 + 1972 1895 1901 1901 1895 1901 1901 - 1 + 1948 2004 2005 2005 - 1 + 2002 1 - 1 - 1 - 1 + 1991 + 2002 + 2005 1 - 1 - 1 - 1 + 1991 + 2005 + 2002 run_component_datm env_run.xml From 66904a2ffb3e68706676b56b0e1a482e29b86d46 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 25 Apr 2019 15:14:22 -0600 Subject: [PATCH 51/54] Generalize DATM_CLMNCEP_YR_ALIGN for present-day compsets As noted in the previous commit: The land group wants DATM_CLMNCEP_YR_ALIGN to match DATM_CLMNCEP_YR_START for present-day compsets. This will make the model year align with the forcing year. This commit generalizes this rule and makes the setting less prone to maintenance errors: if someone changes the default DATM_CLMNCEP_YR_START for a given forcing dataset, they don't need to remember to also change DATM_CLMNCEP_YR_ALIGN. Similarly, if a user changes DATM_CLMNCEP_YR_START in their case, then they also do not need to remember to change DATM_CLMNCEP_YR_ALIGN. --- .../datm/cime_config/config_component.xml | 15 ++++----------- 1 file changed, 4 insertions(+), 11 deletions(-) diff --git a/src/components/data_comps/datm/cime_config/config_component.xml b/src/components/data_comps/datm/cime_config/config_component.xml index ed9540b58e2c..1445e260bd31 100644 --- a/src/components/data_comps/datm/cime_config/config_component.xml +++ b/src/components/data_comps/datm/cime_config/config_component.xml @@ -187,31 +187,24 @@ 1 - 1972 1 1 1 - 2000 - 1972 1895 1901 1901 1895 1901 1901 - 1948 2004 2005 2005 - 2002 1 - 1991 - 2002 - 2005 1 - 1991 - 2005 - 2002 + $DATM_CLMNCEP_YR_START + $DATM_CLMNCEP_YR_START + $DATM_CLMNCEP_YR_START + $DATM_CLMNCEP_YR_START run_component_datm env_run.xml From d49bf707c7cf47b1ed5202fd31543b336a75032b Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 30 Apr 2019 09:23:49 -0600 Subject: [PATCH 52/54] Add NLDAS2 datm forcing option This is a regional, 0.125 degree data set over the U.S., for use in forcing CTSM. This is only supported for present-day compsets. For others, I am setting the end year to earlier than the start year, so that preview_namelists will abort with an error like this: ERROR: Stream CLMNLDAS2.Solar starts at year 0, but ends at earlier year -1. I wanted to prevent users from trying to set up (say) a year-1850 or 20th century transient case with these forcing data. However, I didn't feel this was a likely enough event to warrant a lot of work putting in place a more meaningful error message. --- .../datm/cime_config/config_component.xml | 27 +++++++++++++-- .../cime_config/namelist_definition_datm.xml | 33 +++++++++++++++++++ 2 files changed, 57 insertions(+), 3 deletions(-) diff --git a/src/components/data_comps/datm/cime_config/config_component.xml b/src/components/data_comps/datm/cime_config/config_component.xml index 1445e260bd31..1e508cec0900 100644 --- a/src/components/data_comps/datm/cime_config/config_component.xml +++ b/src/components/data_comps/datm/cime_config/config_component.xml @@ -10,12 +10,13 @@ This file may have atm desc entries. --> - Data driven ATM + Data driven ATM QIAN data set QIAN with water isotopes CRUNCEP data set CLM CRU NCEP v7 data set GSWP3v1 data set + NLDAS2 regional 0.125 degree data set over the U.S. (25-53N, 235-293E). WARNING: Garbage data will be produced for runs extending beyond this regional domain. Coupler hist data set (in this mode, it is strongly recommended that the model domain and the coupler history forcing are on the same domain) single point tower site data set COREv2 normal year forcing @@ -34,13 +35,14 @@ char - CORE2_NYF,CORE2_IAF,CLM_QIAN,CLM_QIAN_WISO,CLM1PT,CLMCRUNCEP,CLMCRUNCEPv7,CLMGSWP3v1,CPLHIST,CORE_IAF_JRA + CORE2_NYF,CORE2_IAF,CLM_QIAN,CLM_QIAN_WISO,CLM1PT,CLMCRUNCEP,CLMCRUNCEPv7,CLMGSWP3v1,CLMNLDAS2,CPLHIST,CORE_IAF_JRA CORE2_NYF run_component_datm env_run.xml Mode for data atmosphere component. CORE2_NYF (CORE2 normal year forcing) are modes used in forcing prognostic ocean/sea-ice components. - CLM_QIAN, CLMCRUNCEP, CLMCRUNCEPv7, CLMGSWP3v1 and CLM1PT are modes using observational data for forcing prognostic land components. + CLM_QIAN, CLMCRUNCEP, CLMCRUNCEPv7, CLMGSWP3v1, CLMNLDAS2 and CLM1PT are modes using observational data for forcing prognostic land components. + WARNING for CLMNLDAS2: This is a regional forcing dataset over the U.S. (25-53N, 235-293E). Garbage data will be produced for runs extending beyond this regional domain. CORE2_NYF CORE2_IAF @@ -50,6 +52,7 @@ CLMCRUNCEP CLMCRUNCEPv7 CLMGSWP3v1 + CLMNLDAS2 CLM1PT CPLHIST @@ -190,15 +193,19 @@ 1 1 1 + 1 1895 1901 1901 + $DATM_CLMNCEP_YR_START 1895 1901 1901 + $DATM_CLMNCEP_YR_START 2004 2005 2005 + 2005 1 1 $DATM_CLMNCEP_YR_START @@ -220,18 +227,22 @@ 1948 1901 1901 + 0 2000 1972 1948 1901 1901 + 0 1948 1901 1901 + 0 1948 1972 1991 1991 + 0 2002 1901 1991 @@ -241,6 +252,9 @@ 1991 2005 2002 + 1980 + 2005 + 2002 run_component_datm env_run.xml @@ -256,18 +270,22 @@ 1972 1920 1920 + -1 2004 2004 1972 1920 1920 + -1 1972 1920 1920 + -1 2004 2004 2010 2010 + -1 2003 1920 2010 @@ -277,6 +295,9 @@ 2010 2014 2003 + 2018 + 2014 + 2003 run_component_datm env_run.xml diff --git a/src/components/data_comps/datm/cime_config/namelist_definition_datm.xml b/src/components/data_comps/datm/cime_config/namelist_definition_datm.xml index 6c9d79c95944..505f28fba0c3 100644 --- a/src/components/data_comps/datm/cime_config/namelist_definition_datm.xml +++ b/src/components/data_comps/datm/cime_config/namelist_definition_datm.xml @@ -36,6 +36,7 @@ CLMCRUNCEP = Run with the CLM CRU NCEP V4 ( default ) forcing valid from 1900 to 2010 (force CLM) CLMCRUNCEPv7 = Run with the CLM CRU NCEP V7 forcing valid from 1900 to 2010 (force CLM) CLMGSWP3v1 = Run with the CLM GSWP3 V1 forcing (force CLM) + CLMNLDAS2 = Run with the CLM NLDAS2 forcing (force CLM) CLM1PT = Run with supplied single point data (force CLM) CORE2_NYF = CORE2 normal year forcing (for forcing POP and CICE) CORE2_IAF = CORE2 intra-annual year forcing (for forcing POP and CICE) @@ -96,6 +97,10 @@ CLMGSWP3v1.Precip CLMGSWP3v1.TPQW + CLMNLDAS2.Solar + CLMNLDAS2.Precip + CLMNLDAS2.TPQW + co2tseries.20tr co2tseries.20tr.latbnd co2tseries.rcp2.6 @@ -171,6 +176,7 @@ CLMCRUNCEP.Solar,CLMCRUNCEP.Precip,CLMCRUNCEP.TPQW CLMCRUNCEPv7.Solar,CLMCRUNCEPv7.Precip,CLMCRUNCEPv7.TPQW CLMGSWP3v1.Solar,CLMGSWP3v1.Precip,CLMGSWP3v1.TPQW + CLMNLDAS2.Solar,CLMNLDAS2.Precip,CLMNLDAS2.TPQW CORE2_NYF.GISS,CORE2_NYF.GXGXS,CORE2_NYF.NCEP CORE2_IAF.GCGCS.PREC,CORE2_IAF.GISS.LWDN,CORE2_IAF.GISS.SWDN,CORE2_IAF.GISS.SWUP,CORE2_IAF.NCEP.DN10,CORE2_IAF.NCEP.Q_10,CORE2_IAF.NCEP.SLP_,CORE2_IAF.NCEP.T_10,CORE2_IAF.NCEP.U_10,CORE2_IAF.NCEP.V_10,CORE2_IAF.CORE2.ArcFactor CORE_IAF_JRA.PREC,CORE_IAF_JRA.LWDN,CORE_IAF_JRA.SWDN,CORE_IAF_JRA.Q_10,CORE_IAF_JRA.SLP_,CORE_IAF_JRA.T_10,CORE_IAF_JRA.U_10,CORE_IAF_JRA.V_10,CORE_IAF_JRA.CORE2.ArcFactor @@ -196,6 +202,7 @@ $DIN_LOC_ROOT/share/domains/domain.clm $DIN_LOC_ROOT_CLMFORC/atm_forcing.datm7.cruncep_qianFill.0.5d.V5.c140715 $DIN_LOC_ROOT_CLMFORC/atm_forcing.datm7.GSWP3.0.5d.v1.c170516 + $DIN_LOC_ROOT/share/domains/domain.clm $DIN_LOC_ROOT/atm/datm7/NYF $DIN_LOC_ROOT/atm/datm7/CORE2 $DIN_LOC_ROOT/share/domains @@ -261,6 +268,7 @@ domain.lnd.360x720.130305.nc domain.lnd.360x720_gswp3.0v1.c170606.nc domain.lnd.360x720_gswp3.0v1.c170606.nc + domain.lnd.0.125nldas2_0.125nldas2.190410.nc nyf.giss.T62.051007.nc nyf.gxgxs.T62.051007.nc nyf.ncep.T62.050923.nc @@ -412,6 +420,9 @@ $DIN_LOC_ROOT_CLMFORC/atm_forcing.datm7.GSWP3.0.5d.v1.c170516/Solar3Hrly $DIN_LOC_ROOT_CLMFORC/atm_forcing.datm7.GSWP3.0.5d.v1.c170516/Precip3Hrly $DIN_LOC_ROOT_CLMFORC/atm_forcing.datm7.GSWP3.0.5d.v1.c170516/TPHWL3Hrly + $DIN_LOC_ROOT/atm/datm7/atm_forcing.datm7.NLDAS2.0.125d.v1/Solar + $DIN_LOC_ROOT/atm/datm7/atm_forcing.datm7.NLDAS2.0.125d.v1/Precip + $DIN_LOC_ROOT/atm/datm7/atm_forcing.datm7.NLDAS2.0.125d.v1/TPQWL $DIN_LOC_ROOT/atm/datm7/NYF $DIN_LOC_ROOT/atm/datm7/CORE2 $DIN_LOC_ROOT/ocn/iaf @@ -485,6 +496,9 @@ clmforc.GSWP3.c2011.0.5x0.5.Solr.%ym.nc clmforc.GSWP3.c2011.0.5x0.5.Prec.%ym.nc clmforc.GSWP3.c2011.0.5x0.5.TPQWL.%ym.nc + ctsmforc.NLDAS2.0.125d.v1.Solr.%ym.nc + ctsmforc.NLDAS2.0.125d.v1.Prec.%ym.nc + ctsmforc.NLDAS2.0.125d.v1.TPQWL.%ym.nc nyf.giss.T62.051007.nc nyf.gxgxs.T62.051007.nc nyf.ncep.T62.050923.nc @@ -1810,6 +1824,19 @@ PSRF pbot FLDS lwdn + + FSDS swdn + + + PRECTmms precn + + + TBOT tbot + WIND wind + QBOT shum + PSRF pbot + FLDS lwdn + lwdn lwdn swdn swdn @@ -2017,6 +2044,7 @@ $DATM_CLMNCEP_YR_ALIGN $DATM_CLMNCEP_YR_ALIGN $DATM_CLMNCEP_YR_ALIGN + $DATM_CLMNCEP_YR_ALIGN 1 1 1 @@ -2057,6 +2085,7 @@ $DATM_CLMNCEP_YR_START $DATM_CLMNCEP_YR_START $DATM_CLMNCEP_YR_START + $DATM_CLMNCEP_YR_START 1 2010 2010 @@ -2123,6 +2152,7 @@ $DATM_CLMNCEP_YR_END $DATM_CLMNCEP_YR_END $DATM_CLMNCEP_YR_END + $DATM_CLMNCEP_YR_END 1 2011 2011 @@ -2371,6 +2401,7 @@ nn copy copy + copy nn @@ -2442,6 +2473,8 @@ nearest coszen nearest + coszen + nearest nearest nearest nearest From e9a7d76e93be4b89ae25eaacc5d96ab44e502c17 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 30 Apr 2019 11:59:26 -0600 Subject: [PATCH 53/54] Remove lines referring to rcp compsets with nldas2 forcing @ekluzek says these will be removed imminently. --- .../data_comps/datm/cime_config/config_component.xml | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/components/data_comps/datm/cime_config/config_component.xml b/src/components/data_comps/datm/cime_config/config_component.xml index 1e508cec0900..04c94974219f 100644 --- a/src/components/data_comps/datm/cime_config/config_component.xml +++ b/src/components/data_comps/datm/cime_config/config_component.xml @@ -205,7 +205,6 @@ 2004 2005 2005 - 2005 1 1 $DATM_CLMNCEP_YR_START @@ -242,7 +241,6 @@ 1972 1991 1991 - 0 2002 1901 1991 @@ -285,7 +283,6 @@ 2004 2010 2010 - -1 2003 1920 2010 From 1b6a2f936fc2152ee15b8ae87ce8a47b2861ec73 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 30 Apr 2019 12:16:09 -0600 Subject: [PATCH 54/54] Add more information in comment --- .../data_comps/datm/cime_config/namelist_definition_datm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/components/data_comps/datm/cime_config/namelist_definition_datm.xml b/src/components/data_comps/datm/cime_config/namelist_definition_datm.xml index 505f28fba0c3..a502d81ce66d 100644 --- a/src/components/data_comps/datm/cime_config/namelist_definition_datm.xml +++ b/src/components/data_comps/datm/cime_config/namelist_definition_datm.xml @@ -36,7 +36,7 @@ CLMCRUNCEP = Run with the CLM CRU NCEP V4 ( default ) forcing valid from 1900 to 2010 (force CLM) CLMCRUNCEPv7 = Run with the CLM CRU NCEP V7 forcing valid from 1900 to 2010 (force CLM) CLMGSWP3v1 = Run with the CLM GSWP3 V1 forcing (force CLM) - CLMNLDAS2 = Run with the CLM NLDAS2 forcing (force CLM) + CLMNLDAS2 = Run with the CLM NLDAS2 regional forcing valid from 1980 to 2018 (force CLM) CLM1PT = Run with supplied single point data (force CLM) CORE2_NYF = CORE2 normal year forcing (for forcing POP and CICE) CORE2_IAF = CORE2 intra-annual year forcing (for forcing POP and CICE)